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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1072  ! raeburn     4: # $Id: loncommon.pm,v 1.1071 2012/04/16 19:30:56 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.479     albertel   70: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    71: use DateTime::TimeZone;
1.687     raeburn    72: use DateTime::Locale::Catalog;
1.117     www        73: 
1.517     raeburn    74: # ---------------------------------------------- Designs
                     75: use vars qw(%defaultdesign);
                     76: 
1.22      www        77: my $readit;
                     78: 
1.517     raeburn    79: 
1.157     matthew    80: ##
                     81: ## Global Variables
                     82: ##
1.46      matthew    83: 
1.643     foxr       84: 
                     85: # ----------------------------------------------- SSI with retries:
                     86: #
                     87: 
                     88: =pod
                     89: 
1.648     raeburn    90: =head1 Server Side include with retries:
1.643     foxr       91: 
                     92: =over 4
                     93: 
1.648     raeburn    94: =item * &ssi_with_retries(resource,retries form)
1.643     foxr       95: 
                     96: Performs an ssi with some number of retries.  Retries continue either
                     97: until the result is ok or until the retry count supplied by the
                     98: caller is exhausted.  
                     99: 
                    100: Inputs:
1.648     raeburn   101: 
                    102: =over 4
                    103: 
1.643     foxr      104: resource   - Identifies the resource to insert.
1.648     raeburn   105: 
1.643     foxr      106: retries    - Count of the number of retries allowed.
1.648     raeburn   107: 
1.643     foxr      108: form       - Hash that identifies the rendering options.
                    109: 
1.648     raeburn   110: =back
                    111: 
                    112: Returns:
                    113: 
                    114: =over 4
                    115: 
1.643     foxr      116: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   117: 
1.643     foxr      118: response   - The response from the last attempt (which may or may not have been successful.
                    119: 
1.648     raeburn   120: =back
                    121: 
                    122: =back
                    123: 
1.643     foxr      124: =cut
                    125: 
                    126: sub ssi_with_retries {
                    127:     my ($resource, $retries, %form) = @_;
                    128: 
                    129: 
                    130:     my $ok = 0;			# True if we got a good response.
                    131:     my $content;
                    132:     my $response;
                    133: 
                    134:     # Try to get the ssi done. within the retries count:
                    135: 
                    136:     do {
                    137: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    138: 	$ok      = $response->is_success;
1.650     www       139:         if (!$ok) {
                    140:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    141:         }
1.643     foxr      142: 	$retries--;
                    143:     } while (!$ok && ($retries > 0));
                    144: 
                    145:     if (!$ok) {
                    146: 	$content = '';		# On error return an empty content.
                    147:     }
                    148:     return ($content, $response);
                    149: 
                    150: }
                    151: 
                    152: 
                    153: 
1.20      www       154: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  155: my %language;
1.124     www       156: my %supported_language;
1.1048    foxr      157: my %latex_language;		# For choosing hyphenation in <transl..>
                    158: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  159: my %cprtag;
1.192     taceyjo1  160: my %scprtag;
1.351     www       161: my %fe; my %fd; my %fm;
1.41      ng        162: my %category_extensions;
1.12      harris41  163: 
1.46      matthew   164: # ---------------------------------------------- Thesaurus variables
1.144     matthew   165: #
                    166: # %Keywords:
                    167: #      A hash used by &keyword to determine if a word is considered a keyword.
                    168: # $thesaurus_db_file 
                    169: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   170: 
                    171: my %Keywords;
                    172: my $thesaurus_db_file;
                    173: 
1.144     matthew   174: #
                    175: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    176: # thesaurus.tab, and filecategories.tab.
                    177: #
1.18      www       178: BEGIN {
1.46      matthew   179:     # Variable initialization
                    180:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    181:     #
1.22      www       182:     unless ($readit) {
1.12      harris41  183: # ------------------------------------------------------------------- languages
                    184:     {
1.158     raeburn   185:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    186:                                    '/language.tab';
                    187:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  188:             while (my $line = <$fh>) {
                    189:                 next if ($line=~/^\#/);
                    190:                 chomp($line);
1.1048    foxr      191:                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   192:                 $language{$key}=$val.' - '.$enc;
                    193:                 if ($sup) {
                    194:                     $supported_language{$key}=$sup;
                    195:                 }
1.1048    foxr      196: 		if ($latex) {
                    197: 		    $latex_language_bykey{$key} = $latex;
                    198: 		    $latex_language{$two} = $latex;
                    199: 		}
1.158     raeburn   200:             }
                    201:             close($fh);
                    202:         }
1.12      harris41  203:     }
                    204: # ------------------------------------------------------------------ copyrights
                    205:     {
1.158     raeburn   206:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    207:                                   '/copyright.tab';
                    208:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  209:             while (my $line = <$fh>) {
                    210:                 next if ($line=~/^\#/);
                    211:                 chomp($line);
                    212:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   213:                 $cprtag{$key}=$val;
                    214:             }
                    215:             close($fh);
                    216:         }
1.12      harris41  217:     }
1.351     www       218: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  219:     {
                    220:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    221:                                   '/source_copyright.tab';
                    222:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  223:             while (my $line = <$fh>) {
                    224:                 next if ($line =~ /^\#/);
                    225:                 chomp($line);
                    226:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  227:                 $scprtag{$key}=$val;
                    228:             }
                    229:             close($fh);
                    230:         }
                    231:     }
1.63      www       232: 
1.517     raeburn   233: # -------------------------------------------------------------- default domain designs
1.63      www       234:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   235:     my $designfile = $designdir.'/default.tab';
                    236:     if ( open (my $fh,"<$designfile") ) {
                    237:         while (my $line = <$fh>) {
                    238:             next if ($line =~ /^\#/);
                    239:             chomp($line);
                    240:             my ($key,$val)=(split(/\=/,$line));
                    241:             if ($val) { $defaultdesign{$key}=$val; }
                    242:         }
                    243:         close($fh);
1.63      www       244:     }
                    245: 
1.15      harris41  246: # ------------------------------------------------------------- file categories
                    247:     {
1.158     raeburn   248:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    249:                                   '/filecategories.tab';
                    250:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  251: 	    while (my $line = <$fh>) {
                    252: 		next if ($line =~ /^\#/);
                    253: 		chomp($line);
                    254:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   255:                 push @{$category_extensions{lc($category)}},$extension;
                    256:             }
                    257:             close($fh);
                    258:         }
                    259: 
1.15      harris41  260:     }
1.12      harris41  261: # ------------------------------------------------------------------ file types
                    262:     {
1.158     raeburn   263:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    264:                '/filetypes.tab';
                    265:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  266:             while (my $line = <$fh>) {
                    267: 		next if ($line =~ /^\#/);
                    268: 		chomp($line);
                    269:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   270:                 if ($descr ne '') {
                    271:                     $fe{$ending}=lc($emb);
                    272:                     $fd{$ending}=$descr;
1.351     www       273:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   274:                 }
                    275:             }
                    276:             close($fh);
                    277:         }
1.12      harris41  278:     }
1.22      www       279:     &Apache::lonnet::logthis(
1.705     tempelho  280:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       281:     $readit=1;
1.46      matthew   282:     }  # end of unless($readit) 
1.32      matthew   283:     
                    284: }
1.112     bowersj2  285: 
1.42      matthew   286: ###############################################################
                    287: ##           HTML and Javascript Helper Functions            ##
                    288: ###############################################################
                    289: 
                    290: =pod 
                    291: 
1.112     bowersj2  292: =head1 HTML and Javascript Functions
1.42      matthew   293: 
1.112     bowersj2  294: =over 4
                    295: 
1.648     raeburn   296: =item * &browser_and_searcher_javascript()
1.112     bowersj2  297: 
                    298: X<browsing, javascript>X<searching, javascript>Returns a string
                    299: containing javascript with two functions, C<openbrowser> and
                    300: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    301: tags.
1.42      matthew   302: 
1.648     raeburn   303: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   304: 
                    305: inputs: formname, elementname, only, omit
                    306: 
                    307: formname and elementname indicate the name of the html form and name of
                    308: the element that the results of the browsing selection are to be placed in. 
                    309: 
                    310: Specifying 'only' will restrict the browser to displaying only files
1.185     www       311: with the given extension.  Can be a comma separated list.
1.42      matthew   312: 
                    313: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       314: with the given extension.  Can be a comma separated list.
1.42      matthew   315: 
1.648     raeburn   316: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   317: 
                    318: Inputs: formname, elementname
                    319: 
                    320: formname and elementname specify the name of the html form and the name
                    321: of the element the selection from the search results will be placed in.
1.542     raeburn   322: 
1.42      matthew   323: =cut
                    324: 
                    325: sub browser_and_searcher_javascript {
1.199     albertel  326:     my ($mode)=@_;
                    327:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  328:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   329:     return <<END;
1.219     albertel  330: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   331:     var editbrowser = null;
1.135     albertel  332:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       333:         var url = '$resurl/?';
1.42      matthew   334:         if (editbrowser == null) {
                    335:             url += 'launch=1&';
                    336:         }
                    337:         url += 'catalogmode=interactive&';
1.199     albertel  338:         url += 'mode=$mode&';
1.611     albertel  339:         url += 'inhibitmenu=yes&';
1.42      matthew   340:         url += 'form=' + formname + '&';
                    341:         if (only != null) {
                    342:             url += 'only=' + only + '&';
1.217     albertel  343:         } else {
                    344:             url += 'only=&';
                    345: 	}
1.42      matthew   346:         if (omit != null) {
                    347:             url += 'omit=' + omit + '&';
1.217     albertel  348:         } else {
                    349:             url += 'omit=&';
                    350: 	}
1.135     albertel  351:         if (titleelement != null) {
                    352:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  353:         } else {
                    354: 	    url += 'titleelement=&';
                    355: 	}
1.42      matthew   356:         url += 'element=' + elementname + '';
                    357:         var title = 'Browser';
1.435     albertel  358:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   359:         options += ',width=700,height=600';
                    360:         editbrowser = open(url,title,options,'1');
                    361:         editbrowser.focus();
                    362:     }
                    363:     var editsearcher;
1.135     albertel  364:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   365:         var url = '/adm/searchcat?';
                    366:         if (editsearcher == null) {
                    367:             url += 'launch=1&';
                    368:         }
                    369:         url += 'catalogmode=interactive&';
1.199     albertel  370:         url += 'mode=$mode&';
1.42      matthew   371:         url += 'form=' + formname + '&';
1.135     albertel  372:         if (titleelement != null) {
                    373:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  374:         } else {
                    375: 	    url += 'titleelement=&';
                    376: 	}
1.42      matthew   377:         url += 'element=' + elementname + '';
                    378:         var title = 'Search';
1.435     albertel  379:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   380:         options += ',width=700,height=600';
                    381:         editsearcher = open(url,title,options,'1');
                    382:         editsearcher.focus();
                    383:     }
1.219     albertel  384: // END LON-CAPA Internal -->
1.42      matthew   385: END
1.170     www       386: }
                    387: 
                    388: sub lastresurl {
1.258     albertel  389:     if ($env{'environment.lastresurl'}) {
                    390: 	return $env{'environment.lastresurl'}
1.170     www       391:     } else {
                    392: 	return '/res';
                    393:     }
                    394: }
                    395: 
                    396: sub storeresurl {
                    397:     my $resurl=&Apache::lonnet::clutter(shift);
                    398:     unless ($resurl=~/^\/res/) { return 0; }
                    399:     $resurl=~s/\/$//;
                    400:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   401:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       402:     return 1;
1.42      matthew   403: }
                    404: 
1.74      www       405: sub studentbrowser_javascript {
1.111     www       406:    unless (
1.258     albertel  407:             (($env{'request.course.id'}) && 
1.302     albertel  408:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    409: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    410: 					  '/'.$env{'request.course.sec'})
                    411: 	      ))
1.258     albertel  412:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       413:           ) { return ''; }  
1.74      www       414:    return (<<'ENDSTDBRW');
1.776     bisitz    415: <script type="text/javascript" language="Javascript">
1.824     bisitz    416: // <![CDATA[
1.74      www       417:     var stdeditbrowser;
1.999     www       418:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       419:         var url = '/adm/pickstudent?';
                    420:         var filter;
1.558     albertel  421: 	if (!ignorefilter) {
                    422: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    423: 	}
1.74      www       424:         if (filter != null) {
                    425:            if (filter != '') {
                    426:                url += 'filter='+filter+'&';
                    427: 	   }
                    428:         }
                    429:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       430:                                     '&udomelement='+udom+
                    431:                                     '&clicker='+clicker;
1.111     www       432: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   433:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       434:         var title = 'Student_Browser';
1.74      www       435:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    436:         options += ',width=700,height=600';
                    437:         stdeditbrowser = open(url,title,options,'1');
                    438:         stdeditbrowser.focus();
                    439:     }
1.824     bisitz    440: // ]]>
1.74      www       441: </script>
                    442: ENDSTDBRW
                    443: }
1.42      matthew   444: 
1.1003    www       445: sub resourcebrowser_javascript {
                    446:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       447:    return (<<'ENDRESBRW');
1.1003    www       448: <script type="text/javascript" language="Javascript">
                    449: // <![CDATA[
                    450:     var reseditbrowser;
1.1004    www       451:     function openresbrowser(formname,reslink) {
1.1005    www       452:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       453:         var title = 'Resource_Browser';
                    454:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       455:         options += ',width=700,height=500';
1.1004    www       456:         reseditbrowser = open(url,title,options,'1');
                    457:         reseditbrowser.focus();
1.1003    www       458:     }
                    459: // ]]>
                    460: </script>
1.1004    www       461: ENDRESBRW
1.1003    www       462: }
                    463: 
1.74      www       464: sub selectstudent_link {
1.999     www       465:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    466:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    467:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    468:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  469:    if ($env{'request.course.id'}) {  
1.302     albertel  470:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    471: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    472: 					'/'.$env{'request.course.sec'})) {
1.111     www       473: 	   return '';
                    474:        }
1.999     www       475:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   476:        if ($courseadvonly)  {
                    477:            $callargs .= ",'',1,1";
                    478:        }
                    479:        return '<span class="LC_nobreak">'.
                    480:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    481:               &mt('Select User').'</a></span>';
1.74      www       482:    }
1.258     albertel  483:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       484:        $callargs .= ",'',1"; 
1.793     raeburn   485:        return '<span class="LC_nobreak">'.
                    486:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    487:               &mt('Select User').'</a></span>';
1.111     www       488:    }
                    489:    return '';
1.91      www       490: }
                    491: 
1.1004    www       492: sub selectresource_link {
                    493:    my ($form,$reslink,$arg)=@_;
                    494:    
                    495:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    496:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    497:    unless ($env{'request.course.id'}) { return $arg; }
                    498:    return '<span class="LC_nobreak">'.
                    499:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    500:               $arg.'</a></span>';
                    501: }
                    502: 
                    503: 
                    504: 
1.653     raeburn   505: sub authorbrowser_javascript {
                    506:     return <<"ENDAUTHORBRW";
1.776     bisitz    507: <script type="text/javascript" language="JavaScript">
1.824     bisitz    508: // <![CDATA[
1.653     raeburn   509: var stdeditbrowser;
                    510: 
                    511: function openauthorbrowser(formname,udom) {
                    512:     var url = '/adm/pickauthor?';
                    513:     url += 'form='+formname+'&roledom='+udom;
                    514:     var title = 'Author_Browser';
                    515:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    516:     options += ',width=700,height=600';
                    517:     stdeditbrowser = open(url,title,options,'1');
                    518:     stdeditbrowser.focus();
                    519: }
                    520: 
1.824     bisitz    521: // ]]>
1.653     raeburn   522: </script>
                    523: ENDAUTHORBRW
                    524: }
                    525: 
1.91      www       526: sub coursebrowser_javascript {
1.909     raeburn   527:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype) = @_;
1.932     raeburn   528:     my $wintitle = 'Course_Browser';
1.931     raeburn   529:     if ($crstype eq 'Community') {
1.932     raeburn   530:         $wintitle = 'Community_Browser';
1.909     raeburn   531:     }
1.876     raeburn   532:     my $id_functions = &javascript_index_functions();
                    533:     my $output = '
1.776     bisitz    534: <script type="text/javascript" language="JavaScript">
1.824     bisitz    535: // <![CDATA[
1.468     raeburn   536:     var stdeditbrowser;'."\n";
1.876     raeburn   537: 
                    538:     $output .= <<"ENDSTDBRW";
1.909     raeburn   539:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       540:         var url = '/adm/pickcourse?';
1.895     raeburn   541:         var formid = getFormIdByName(formname);
1.876     raeburn   542:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  543:         if (domainfilter != null) {
                    544:            if (domainfilter != '') {
                    545:                url += 'domainfilter='+domainfilter+'&';
                    546: 	   }
                    547:         }
1.91      www       548:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  549: 	                            '&cdomelement='+udom+
                    550:                                     '&cnameelement='+desc;
1.468     raeburn   551:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   552:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   553:                 url += '&roleelement='+extra_element;
                    554:                 if (domainfilter == null || domainfilter == '') {
                    555:                     url += '&domainfilter='+extra_element;
                    556:                 }
1.234     raeburn   557:             }
1.468     raeburn   558:             else {
                    559:                 if (formname == 'portform') {
                    560:                     url += '&setroles='+extra_element;
1.800     raeburn   561:                 } else {
                    562:                     if (formname == 'rules') {
                    563:                         url += '&fixeddom='+extra_element; 
                    564:                     }
1.468     raeburn   565:                 }
                    566:             }     
1.230     raeburn   567:         }
1.909     raeburn   568:         if (type != null && type != '') {
                    569:             url += '&type='+type;
                    570:         }
                    571:         if (type_elem != null && type_elem != '') {
                    572:             url += '&typeelement='+type_elem;
                    573:         }
1.872     raeburn   574:         if (formname == 'ccrs') {
                    575:             var ownername = document.forms[formid].ccuname.value;
                    576:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    577:             url += '&cloner='+ownername+':'+ownerdom;
                    578:         }
1.293     raeburn   579:         if (multflag !=null && multflag != '') {
                    580:             url += '&multiple='+multflag;
                    581:         }
1.909     raeburn   582:         var title = '$wintitle';
1.91      www       583:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    584:         options += ',width=700,height=600';
                    585:         stdeditbrowser = open(url,title,options,'1');
                    586:         stdeditbrowser.focus();
                    587:     }
1.876     raeburn   588: $id_functions
                    589: ENDSTDBRW
1.905     raeburn   590:     if (($sec_element ne '') || ($role_element ne '')) {
                    591:         $output .= &setsec_javascript($sec_element,$formname,$role_element);
1.876     raeburn   592:     }
                    593:     $output .= '
                    594: // ]]>
                    595: </script>';
                    596:     return $output;
                    597: }
                    598: 
                    599: sub javascript_index_functions {
                    600:     return <<"ENDJS";
                    601: 
                    602: function getFormIdByName(formname) {
                    603:     for (var i=0;i<document.forms.length;i++) {
                    604:         if (document.forms[i].name == formname) {
                    605:             return i;
                    606:         }
                    607:     }
                    608:     return -1;
                    609: }
                    610: 
                    611: function getIndexByName(formid,item) {
                    612:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    613:         if (document.forms[formid].elements[i].name == item) {
                    614:             return i;
                    615:         }
                    616:     }
                    617:     return -1;
                    618: }
1.468     raeburn   619: 
1.876     raeburn   620: function getDomainFromSelectbox(formname,udom) {
                    621:     var userdom;
                    622:     var formid = getFormIdByName(formname);
                    623:     if (formid > -1) {
                    624:         var domid = getIndexByName(formid,udom);
                    625:         if (domid > -1) {
                    626:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    627:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    628:             }
                    629:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    630:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   631:             }
                    632:         }
                    633:     }
1.876     raeburn   634:     return userdom;
                    635: }
                    636: 
                    637: ENDJS
1.468     raeburn   638: 
1.876     raeburn   639: }
                    640: 
1.1017    raeburn   641: sub javascript_array_indexof {
1.1018    raeburn   642:     return <<ENDJS;
1.1017    raeburn   643: <script type="text/javascript" language="JavaScript">
                    644: // <![CDATA[
                    645: 
                    646: if (!Array.prototype.indexOf) {
                    647:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    648:         "use strict";
                    649:         if (this === void 0 || this === null) {
                    650:             throw new TypeError();
                    651:         }
                    652:         var t = Object(this);
                    653:         var len = t.length >>> 0;
                    654:         if (len === 0) {
                    655:             return -1;
                    656:         }
                    657:         var n = 0;
                    658:         if (arguments.length > 0) {
                    659:             n = Number(arguments[1]);
                    660:             if (n !== n) { // shortcut for verifying if it's NaN
                    661:                 n = 0;
                    662:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    663:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    664:             }
                    665:         }
                    666:         if (n >= len) {
                    667:             return -1;
                    668:         }
                    669:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    670:         for (; k < len; k++) {
                    671:             if (k in t && t[k] === searchElement) {
                    672:                 return k;
                    673:             }
                    674:         }
                    675:         return -1;
                    676:     }
                    677: }
                    678: 
                    679: // ]]>
                    680: </script>
                    681: 
                    682: ENDJS
                    683: 
                    684: }
                    685: 
1.876     raeburn   686: sub userbrowser_javascript {
                    687:     my $id_functions = &javascript_index_functions();
                    688:     return <<"ENDUSERBRW";
                    689: 
1.888     raeburn   690: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   691:     var url = '/adm/pickuser?';
                    692:     var userdom = getDomainFromSelectbox(formname,udom);
                    693:     if (userdom != null) {
                    694:        if (userdom != '') {
                    695:            url += 'srchdom='+userdom+'&';
                    696:        }
                    697:     }
                    698:     url += 'form=' + formname + '&unameelement='+uname+
                    699:                                 '&udomelement='+udom+
                    700:                                 '&ulastelement='+ulast+
                    701:                                 '&ufirstelement='+ufirst+
                    702:                                 '&uemailelement='+uemail+
1.881     raeburn   703:                                 '&hideudomelement='+hideudom+
                    704:                                 '&coursedom='+crsdom;
1.888     raeburn   705:     if ((caller != null) && (caller != undefined)) {
                    706:         url += '&caller='+caller;
                    707:     }
1.876     raeburn   708:     var title = 'User_Browser';
                    709:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    710:     options += ',width=700,height=600';
                    711:     var stdeditbrowser = open(url,title,options,'1');
                    712:     stdeditbrowser.focus();
                    713: }
                    714: 
1.888     raeburn   715: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   716:     var formid = getFormIdByName(formname);
                    717:     if (formid > -1) {
1.888     raeburn   718:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   719:         var domid = getIndexByName(formid,udom);
                    720:         var hidedomid = getIndexByName(formid,origdom);
                    721:         if (hidedomid > -1) {
                    722:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   723:             var unameval = document.forms[formid].elements[unameid].value;
                    724:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    725:                 if (domid > -1) {
                    726:                     var slct = document.forms[formid].elements[domid];
                    727:                     if (slct.type == 'select-one') {
                    728:                         var i;
                    729:                         for (i=0;i<slct.length;i++) {
                    730:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    731:                         }
                    732:                     }
                    733:                     if (slct.type == 'hidden') {
                    734:                         slct.value = fixeddom;
1.876     raeburn   735:                     }
                    736:                 }
1.468     raeburn   737:             }
                    738:         }
                    739:     }
1.876     raeburn   740:     return;
                    741: }
                    742: 
                    743: $id_functions
                    744: ENDUSERBRW
1.468     raeburn   745: }
                    746: 
                    747: sub setsec_javascript {
1.905     raeburn   748:     my ($sec_element,$formname,$role_element) = @_;
                    749:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    750:         $communityrolestr);
                    751:     if ($role_element ne '') {
                    752:         my @allroles = ('st','ta','ep','in','ad');
                    753:         foreach my $crstype ('Course','Community') {
                    754:             if ($crstype eq 'Community') {
                    755:                 foreach my $role (@allroles) {
                    756:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    757:                 }
                    758:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    759:             } else {
                    760:                 foreach my $role (@allroles) {
                    761:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    762:                 }
                    763:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    764:             }
                    765:         }
                    766:         $rolestr = '"'.join('","',@allroles).'"';
                    767:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    768:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    769:     }
1.468     raeburn   770:     my $setsections = qq|
                    771: function setSect(sectionlist) {
1.629     raeburn   772:     var sectionsArray = new Array();
                    773:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    774:         sectionsArray = sectionlist.split(",");
                    775:     }
1.468     raeburn   776:     var numSections = sectionsArray.length;
                    777:     document.$formname.$sec_element.length = 0;
                    778:     if (numSections == 0) {
                    779:         document.$formname.$sec_element.multiple=false;
                    780:         document.$formname.$sec_element.size=1;
                    781:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    782:     } else {
                    783:         if (numSections == 1) {
                    784:             document.$formname.$sec_element.multiple=false;
                    785:             document.$formname.$sec_element.size=1;
                    786:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    787:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    788:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    789:         } else {
                    790:             for (var i=0; i<numSections; i++) {
                    791:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    792:             }
                    793:             document.$formname.$sec_element.multiple=true
                    794:             if (numSections < 3) {
                    795:                 document.$formname.$sec_element.size=numSections;
                    796:             } else {
                    797:                 document.$formname.$sec_element.size=3;
                    798:             }
                    799:             document.$formname.$sec_element.options[0].selected = false
                    800:         }
                    801:     }
1.91      www       802: }
1.905     raeburn   803: 
                    804: function setRole(crstype) {
1.468     raeburn   805: |;
1.905     raeburn   806:     if ($role_element eq '') {
                    807:         $setsections .= '    return;
                    808: }
                    809: ';
                    810:     } else {
                    811:         $setsections .= qq|
                    812:     var elementLength = document.$formname.$role_element.length;
                    813:     var allroles = Array($rolestr);
                    814:     var courserolenames = Array($courserolestr);
                    815:     var communityrolenames = Array($communityrolestr);
                    816:     if (elementLength != undefined) {
                    817:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    818:             if (crstype == 'Course') {
                    819:                 return;
                    820:             } else {
                    821:                 allroles[5] = 'co';
                    822:                 for (var i=0; i<6; i++) {
                    823:                     document.$formname.$role_element.options[i].value = allroles[i];
                    824:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    825:                 }
                    826:             }
                    827:         } else {
                    828:             if (crstype == 'Community') {
                    829:                 return;
                    830:             } else {
                    831:                 allroles[5] = 'cc';
                    832:                 for (var i=0; i<6; i++) {
                    833:                     document.$formname.$role_element.options[i].value = allroles[i];
                    834:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    835:                 }
                    836:             }
                    837:         }
                    838:     }
                    839:     return;
                    840: }
                    841: |;
                    842:     }
1.468     raeburn   843:     return $setsections;
                    844: }
                    845: 
1.91      www       846: sub selectcourse_link {
1.909     raeburn   847:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    848:        $typeelement) = @_;
                    849:    my $type = $selecttype;
1.871     raeburn   850:    my $linktext = &mt('Select Course');
                    851:    if ($selecttype eq 'Community') {
1.909     raeburn   852:        $linktext = &mt('Select Community');
1.906     raeburn   853:    } elsif ($selecttype eq 'Course/Community') {
                    854:        $linktext = &mt('Select Course/Community');
1.909     raeburn   855:        $type = '';
1.1019    raeburn   856:    } elsif ($selecttype eq 'Select') {
                    857:        $linktext = &mt('Select');
                    858:        $type = '';
1.871     raeburn   859:    }
1.787     bisitz    860:    return '<span class="LC_nobreak">'
                    861:          ."<a href='"
                    862:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    863:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   864:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   865:          ."'>".$linktext.'</a>'
1.787     bisitz    866:          .'</span>';
1.74      www       867: }
1.42      matthew   868: 
1.653     raeburn   869: sub selectauthor_link {
                    870:    my ($form,$udom)=@_;
                    871:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    872:           &mt('Select Author').'</a>';
                    873: }
                    874: 
1.876     raeburn   875: sub selectuser_link {
1.881     raeburn   876:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   877:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   878:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   879:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   880:            ');">'.$linktext.'</a>';
1.876     raeburn   881: }
                    882: 
1.273     raeburn   883: sub check_uncheck_jscript {
                    884:     my $jscript = <<"ENDSCRT";
                    885: function checkAll(field) {
                    886:     if (field.length > 0) {
                    887:         for (i = 0; i < field.length; i++) {
                    888:             field[i].checked = true ;
                    889:         }
                    890:     } else {
                    891:         field.checked = true
                    892:     }
                    893: }
                    894:  
                    895: function uncheckAll(field) {
                    896:     if (field.length > 0) {
                    897:         for (i = 0; i < field.length; i++) {
                    898:             field[i].checked = false ;
1.543     albertel  899:         }
                    900:     } else {
1.273     raeburn   901:         field.checked = false ;
                    902:     }
                    903: }
                    904: ENDSCRT
                    905:     return $jscript;
                    906: }
                    907: 
1.656     www       908: sub select_timezone {
1.659     raeburn   909:    my ($name,$selected,$onchange,$includeempty)=@_;
                    910:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    911:    if ($includeempty) {
                    912:        $output .= '<option value=""';
                    913:        if (($selected eq '') || ($selected eq 'local')) {
                    914:            $output .= ' selected="selected" ';
                    915:        }
                    916:        $output .= '> </option>';
                    917:    }
1.657     raeburn   918:    my @timezones = DateTime::TimeZone->all_names;
                    919:    foreach my $tzone (@timezones) {
                    920:        $output.= '<option value="'.$tzone.'"';
                    921:        if ($tzone eq $selected) {
                    922:            $output.=' selected="selected"';
                    923:        }
                    924:        $output.=">$tzone</option>\n";
1.656     www       925:    }
                    926:    $output.="</select>";
                    927:    return $output;
                    928: }
1.273     raeburn   929: 
1.687     raeburn   930: sub select_datelocale {
                    931:     my ($name,$selected,$onchange,$includeempty)=@_;
                    932:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    933:     if ($includeempty) {
                    934:         $output .= '<option value=""';
                    935:         if ($selected eq '') {
                    936:             $output .= ' selected="selected" ';
                    937:         }
                    938:         $output .= '> </option>';
                    939:     }
                    940:     my (@possibles,%locale_names);
                    941:     my @locales = DateTime::Locale::Catalog::Locales;
                    942:     foreach my $locale (@locales) {
                    943:         if (ref($locale) eq 'HASH') {
                    944:             my $id = $locale->{'id'};
                    945:             if ($id ne '') {
                    946:                 my $en_terr = $locale->{'en_territory'};
                    947:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   948:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   949:                 if (grep(/^en$/,@languages) || !@languages) {
                    950:                     if ($en_terr ne '') {
                    951:                         $locale_names{$id} = '('.$en_terr.')';
                    952:                     } elsif ($native_terr ne '') {
                    953:                         $locale_names{$id} = $native_terr;
                    954:                     }
                    955:                 } else {
                    956:                     if ($native_terr ne '') {
                    957:                         $locale_names{$id} = $native_terr.' ';
                    958:                     } elsif ($en_terr ne '') {
                    959:                         $locale_names{$id} = '('.$en_terr.')';
                    960:                     }
                    961:                 }
                    962:                 push (@possibles,$id);
                    963:             }
                    964:         }
                    965:     }
                    966:     foreach my $item (sort(@possibles)) {
                    967:         $output.= '<option value="'.$item.'"';
                    968:         if ($item eq $selected) {
                    969:             $output.=' selected="selected"';
                    970:         }
                    971:         $output.=">$item";
                    972:         if ($locale_names{$item} ne '') {
                    973:             $output.="  $locale_names{$item}</option>\n";
                    974:         }
                    975:         $output.="</option>\n";
                    976:     }
                    977:     $output.="</select>";
                    978:     return $output;
                    979: }
                    980: 
1.792     raeburn   981: sub select_language {
                    982:     my ($name,$selected,$includeempty) = @_;
                    983:     my %langchoices;
                    984:     if ($includeempty) {
                    985:         %langchoices = ('' => 'No language preference');
                    986:     }
                    987:     foreach my $id (&languageids()) {
                    988:         my $code = &supportedlanguagecode($id);
                    989:         if ($code) {
                    990:             $langchoices{$code} = &plainlanguagedescription($id);
                    991:         }
                    992:     }
1.970     raeburn   993:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn   994: }
                    995: 
1.42      matthew   996: =pod
1.36      matthew   997: 
1.648     raeburn   998: =item * &linked_select_forms(...)
1.36      matthew   999: 
                   1000: linked_select_forms returns a string containing a <script></script> block
                   1001: and html for two <select> menus.  The select menus will be linked in that
                   1002: changing the value of the first menu will result in new values being placed
                   1003: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1004: order unless a defined order is provided.
1.36      matthew  1005: 
                   1006: linked_select_forms takes the following ordered inputs:
                   1007: 
                   1008: =over 4
                   1009: 
1.112     bowersj2 1010: =item * $formname, the name of the <form> tag
1.36      matthew  1011: 
1.112     bowersj2 1012: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1013: 
1.112     bowersj2 1014: =item * $firstdefault, the default value for the first menu
1.36      matthew  1015: 
1.112     bowersj2 1016: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1017: 
1.112     bowersj2 1018: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1019: 
1.112     bowersj2 1020: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1021: 
1.609     raeburn  1022: =item * $menuorder, the order of values in the first menu
                   1023: 
1.41      ng       1024: =back 
                   1025: 
1.36      matthew  1026: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1027: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1028: values for the first select menu.  The text that coincides with the 
1.41      ng       1029: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1030: and text for the second menu are given in the hash pointed to by 
                   1031: $menu{$choice1}->{'select2'}.  
                   1032: 
1.112     bowersj2 1033:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1034:                        default => "B3",
                   1035:                        select2 => { 
                   1036:                            B1 => "Choice B1",
                   1037:                            B2 => "Choice B2",
                   1038:                            B3 => "Choice B3",
                   1039:                            B4 => "Choice B4"
1.609     raeburn  1040:                            },
                   1041:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1042:                    },
                   1043:                A2 => { text =>"Choice A2" ,
                   1044:                        default => "C2",
                   1045:                        select2 => { 
                   1046:                            C1 => "Choice C1",
                   1047:                            C2 => "Choice C2",
                   1048:                            C3 => "Choice C3"
1.609     raeburn  1049:                            },
                   1050:                        order => ['C2','C1','C3'],
1.112     bowersj2 1051:                    },
                   1052:                A3 => { text =>"Choice A3" ,
                   1053:                        default => "D6",
                   1054:                        select2 => { 
                   1055:                            D1 => "Choice D1",
                   1056:                            D2 => "Choice D2",
                   1057:                            D3 => "Choice D3",
                   1058:                            D4 => "Choice D4",
                   1059:                            D5 => "Choice D5",
                   1060:                            D6 => "Choice D6",
                   1061:                            D7 => "Choice D7"
1.609     raeburn  1062:                            },
                   1063:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1064:                    }
                   1065:                );
1.36      matthew  1066: 
                   1067: =cut
                   1068: 
                   1069: sub linked_select_forms {
                   1070:     my ($formname,
                   1071:         $middletext,
                   1072:         $firstdefault,
                   1073:         $firstselectname,
                   1074:         $secondselectname, 
1.609     raeburn  1075:         $hashref,
                   1076:         $menuorder,
1.36      matthew  1077:         ) = @_;
                   1078:     my $second = "document.$formname.$secondselectname";
                   1079:     my $first = "document.$formname.$firstselectname";
                   1080:     # output the javascript to do the changing
                   1081:     my $result = '';
1.776     bisitz   1082:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1083:     $result.="// <![CDATA[\n";
1.36      matthew  1084:     $result.="var select2data = new Object();\n";
                   1085:     $" = '","';
                   1086:     my $debug = '';
                   1087:     foreach my $s1 (sort(keys(%$hashref))) {
                   1088:         $result.="select2data.d_$s1 = new Object();\n";        
                   1089:         $result.="select2data.d_$s1.def = new String('".
                   1090:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1091:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1092:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1093:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1094:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1095:         }
1.36      matthew  1096:         $result.="\"@s2values\");\n";
                   1097:         $result.="select2data.d_$s1.texts = new Array(";        
                   1098:         my @s2texts;
                   1099:         foreach my $value (@s2values) {
                   1100:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1101:         }
                   1102:         $result.="\"@s2texts\");\n";
                   1103:     }
                   1104:     $"=' ';
                   1105:     $result.= <<"END";
                   1106: 
                   1107: function select1_changed() {
                   1108:     // Determine new choice
                   1109:     var newvalue = "d_" + $first.value;
                   1110:     // update select2
                   1111:     var values     = select2data[newvalue].values;
                   1112:     var texts      = select2data[newvalue].texts;
                   1113:     var select2def = select2data[newvalue].def;
                   1114:     var i;
                   1115:     // out with the old
                   1116:     for (i = 0; i < $second.options.length; i++) {
                   1117:         $second.options[i] = null;
                   1118:     }
                   1119:     // in with the nuclear
                   1120:     for (i=0;i<values.length; i++) {
                   1121:         $second.options[i] = new Option(values[i]);
1.143     matthew  1122:         $second.options[i].value = values[i];
1.36      matthew  1123:         $second.options[i].text = texts[i];
                   1124:         if (values[i] == select2def) {
                   1125:             $second.options[i].selected = true;
                   1126:         }
                   1127:     }
                   1128: }
1.824     bisitz   1129: // ]]>
1.36      matthew  1130: </script>
                   1131: END
                   1132:     # output the initial values for the selection lists
                   1133:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
1.609     raeburn  1134:     my @order = sort(keys(%{$hashref}));
                   1135:     if (ref($menuorder) eq 'ARRAY') {
                   1136:         @order = @{$menuorder};
                   1137:     }
                   1138:     foreach my $value (@order) {
1.36      matthew  1139:         $result.="    <option value=\"$value\" ";
1.253     albertel 1140:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1141:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1142:     }
                   1143:     $result .= "</select>\n";
                   1144:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1145:     $result .= $middletext;
                   1146:     $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
                   1147:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1148:     
                   1149:     my @secondorder = sort(keys(%select2));
                   1150:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1151:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1152:     }
                   1153:     foreach my $value (@secondorder) {
1.36      matthew  1154:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1155:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1156:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1157:     }
                   1158:     $result .= "</select>\n";
                   1159:     #    return $debug;
                   1160:     return $result;
                   1161: }   #  end of sub linked_select_forms {
                   1162: 
1.45      matthew  1163: =pod
1.44      bowersj2 1164: 
1.973     raeburn  1165: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1166: 
1.112     bowersj2 1167: Returns a string corresponding to an HTML link to the given help
                   1168: $topic, where $topic corresponds to the name of a .tex file in
                   1169: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1170: spaces. 
                   1171: 
                   1172: $text will optionally be linked to the same topic, allowing you to
                   1173: link text in addition to the graphic. If you do not want to link
                   1174: text, but wish to specify one of the later parameters, pass an
                   1175: empty string. 
                   1176: 
                   1177: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1178: the link will not open a new window. If false, the link will open
                   1179: a new window using Javascript. (Default is false.) 
                   1180: 
                   1181: $width and $height are optional numerical parameters that will
                   1182: override the width and height of the popped up window, which may
1.973     raeburn  1183: be useful for certain help topics with big pictures included.
                   1184: 
                   1185: $imgid is the id of the img tag used for the help icon. This may be
                   1186: used in a javascript call to switch the image src.  See 
                   1187: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1188: 
                   1189: =cut
                   1190: 
                   1191: sub help_open_topic {
1.973     raeburn  1192:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1193:     $text = "" if (not defined $text);
1.44      bowersj2 1194:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1195:     $width = 500 if (not defined $width);
1.44      bowersj2 1196:     $height = 400 if (not defined $height);
                   1197:     my $filename = $topic;
                   1198:     $filename =~ s/ /_/g;
                   1199: 
1.48      bowersj2 1200:     my $template = "";
                   1201:     my $link;
1.572     banghart 1202:     
1.159     www      1203:     $topic=~s/\W/\_/g;
1.44      bowersj2 1204: 
1.572     banghart 1205:     if (!$stayOnPage) {
1.1033    www      1206: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1207:     } elsif ($stayOnPage eq 'popup') {
                   1208:         $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 1209:     } else {
1.48      bowersj2 1210: 	$link = "/adm/help/${filename}.hlp";
                   1211:     }
                   1212: 
                   1213:     # Add the text
1.755     neumanie 1214:     if ($text ne "") {	
1.763     bisitz   1215: 	$template.='<span class="LC_help_open_topic">'
                   1216:                   .'<a target="_top" href="'.$link.'">'
                   1217:                   .$text.'</a>';
1.48      bowersj2 1218:     }
                   1219: 
1.763     bisitz   1220:     # (Always) Add the graphic
1.179     matthew  1221:     my $title = &mt('Online Help');
1.667     raeburn  1222:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1223:     if ($imgid ne '') {
                   1224:         $imgid = ' id="'.$imgid.'"';
                   1225:     }
1.763     bisitz   1226:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1227:               .'<img src="'.$helpicon.'" border="0"'
                   1228:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1229:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1230:               .' /></a>';
                   1231:     if ($text ne "") {	
                   1232:         $template.='</span>';
                   1233:     }
1.44      bowersj2 1234:     return $template;
                   1235: 
1.106     bowersj2 1236: }
                   1237: 
                   1238: # This is a quicky function for Latex cheatsheet editing, since it 
                   1239: # appears in at least four places
                   1240: sub helpLatexCheatsheet {
1.1037    www      1241:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1242:     my $out;
1.106     bowersj2 1243:     my $addOther = '';
1.732     raeburn  1244:     if ($topic) {
1.1037    www      1245: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1246:     }
                   1247:     $out = '<span>' # Start cheatsheet
                   1248: 	  .$addOther
                   1249:           .'<span>'
1.1037    www      1250: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1251: 	  .'</span> <span>'
1.1037    www      1252: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1253: 	  .'</span>';
1.732     raeburn  1254:     unless ($not_author) {
1.763     bisitz   1255:         $out .= ' <span>'
1.1037    www      1256: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763     bisitz   1257: 	       .'</span>';
1.732     raeburn  1258:     }
1.763     bisitz   1259:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1260:     return $out;
1.172     www      1261: }
                   1262: 
1.430     albertel 1263: sub general_help {
                   1264:     my $helptopic='Student_Intro';
                   1265:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1266: 	$helptopic='Authoring_Intro';
1.907     raeburn  1267:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1268: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1269:     } elsif ($env{'request.role'}=~/^dc/) {
                   1270:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1271:     }
                   1272:     return $helptopic;
                   1273: }
                   1274: 
                   1275: sub update_help_link {
                   1276:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1277:     my $origurl = $ENV{'REQUEST_URI'};
                   1278:     $origurl=~s|^/~|/priv/|;
                   1279:     my $timestamp = time;
                   1280:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1281:         $$datum = &escape($$datum);
                   1282:     }
                   1283: 
                   1284:     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";
                   1285:     my $output .= <<"ENDOUTPUT";
                   1286: <script type="text/javascript">
1.824     bisitz   1287: // <![CDATA[
1.430     albertel 1288: banner_link = '$banner_link';
1.824     bisitz   1289: // ]]>
1.430     albertel 1290: </script>
                   1291: ENDOUTPUT
                   1292:     return $output;
                   1293: }
                   1294: 
                   1295: # now just updates the help link and generates a blue icon
1.193     raeburn  1296: sub help_open_menu {
1.430     albertel 1297:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1298: 	= @_;    
1.949     droeschl 1299:     $stayOnPage = 1;
1.430     albertel 1300:     my $output;
                   1301:     if ($component_help) {
                   1302: 	if (!$text) {
                   1303: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1304: 				       $width,$height);
                   1305: 	} else {
                   1306: 	    my $help_text;
                   1307: 	    $help_text=&unescape($topic);
                   1308: 	    $output='<table><tr><td>'.
                   1309: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1310: 				 $width,$height).'</td></tr></table>';
                   1311: 	}
                   1312:     }
                   1313:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1314:     return $output.$banner_link;
                   1315: }
                   1316: 
                   1317: sub top_nav_help {
                   1318:     my ($text) = @_;
1.436     albertel 1319:     $text = &mt($text);
1.949     droeschl 1320:     my $stay_on_page = 1;
                   1321: 
1.572     banghart 1322:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1323: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1324:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1325: 
1.201     raeburn  1326:     my $title = &mt('Get help');
1.436     albertel 1327: 
                   1328:     return <<"END";
                   1329: $banner_link
                   1330:  <a href="$link" title="$title">$text</a>
                   1331: END
                   1332: }
                   1333: 
                   1334: sub help_menu_js {
                   1335:     my ($text) = @_;
1.949     droeschl 1336:     my $stayOnPage = 1;
1.436     albertel 1337:     my $width = 620;
                   1338:     my $height = 600;
1.430     albertel 1339:     my $helptopic=&general_help();
                   1340:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1341:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1342:     my $start_page =
                   1343:         &Apache::loncommon::start_page('Help Menu', undef,
                   1344: 				       {'frameset'    => 1,
                   1345: 					'js_ready'    => 1,
                   1346: 					'add_entries' => {
                   1347: 					    'border' => '0',
1.579     raeburn  1348: 					    'rows'   => "110,*",},});
1.331     albertel 1349:     my $end_page =
                   1350:         &Apache::loncommon::end_page({'frameset' => 1,
                   1351: 				      'js_ready' => 1,});
                   1352: 
1.436     albertel 1353:     my $template .= <<"ENDTEMPLATE";
                   1354: <script type="text/javascript">
1.877     bisitz   1355: // <![CDATA[
1.253     albertel 1356: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1357: var banner_link = '';
1.243     raeburn  1358: function helpMenu(target) {
                   1359:     var caller = this;
                   1360:     if (target == 'open') {
                   1361:         var newWindow = null;
                   1362:         try {
1.262     albertel 1363:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1364:         }
                   1365:         catch(error) {
                   1366:             writeHelp(caller);
                   1367:             return;
                   1368:         }
                   1369:         if (newWindow) {
                   1370:             caller = newWindow;
                   1371:         }
1.193     raeburn  1372:     }
1.243     raeburn  1373:     writeHelp(caller);
                   1374:     return;
                   1375: }
                   1376: function writeHelp(caller) {
1.1072  ! raeburn  1377:     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  1378:     caller.document.close()
                   1379:     caller.focus()
1.193     raeburn  1380: }
1.877     bisitz   1381: // END LON-CAPA Internal -->
1.253     albertel 1382: // ]]>
1.436     albertel 1383: </script>
1.193     raeburn  1384: ENDTEMPLATE
                   1385:     return $template;
                   1386: }
                   1387: 
1.172     www      1388: sub help_open_bug {
                   1389:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1390:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1391:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1392:     $text = "" if (not defined $text);
                   1393: 	$stayOnPage=1;
1.184     albertel 1394:     $width = 600 if (not defined $width);
                   1395:     $height = 600 if (not defined $height);
1.172     www      1396: 
                   1397:     $topic=~s/\W+/\+/g;
                   1398:     my $link='';
                   1399:     my $template='';
1.379     albertel 1400:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1401: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1402:     if (!$stayOnPage)
                   1403:     {
                   1404: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1405:     }
                   1406:     else
                   1407:     {
                   1408: 	$link = $url;
                   1409:     }
                   1410:     # Add the text
                   1411:     if ($text ne "")
                   1412:     {
                   1413: 	$template .= 
                   1414:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1415:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1416:     }
                   1417: 
                   1418:     # Add the graphic
1.179     matthew  1419:     my $title = &mt('Report a Bug');
1.215     albertel 1420:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1421:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1422:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1423: ENDTEMPLATE
                   1424:     if ($text ne '') { $template.='</td></tr></table>' };
                   1425:     return $template;
                   1426: 
                   1427: }
                   1428: 
                   1429: sub help_open_faq {
                   1430:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1431:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1432:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1433:     $text = "" if (not defined $text);
                   1434: 	$stayOnPage=1;
                   1435:     $width = 350 if (not defined $width);
                   1436:     $height = 400 if (not defined $height);
                   1437: 
                   1438:     $topic=~s/\W+/\+/g;
                   1439:     my $link='';
                   1440:     my $template='';
                   1441:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1442:     if (!$stayOnPage)
                   1443:     {
                   1444: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1445:     }
                   1446:     else
                   1447:     {
                   1448: 	$link = $url;
                   1449:     }
                   1450: 
                   1451:     # Add the text
                   1452:     if ($text ne "")
                   1453:     {
                   1454: 	$template .= 
1.173     www      1455:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1456:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1457:     }
                   1458: 
                   1459:     # Add the graphic
1.179     matthew  1460:     my $title = &mt('View the FAQ');
1.215     albertel 1461:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1462:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1463:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1464: ENDTEMPLATE
                   1465:     if ($text ne '') { $template.='</td></tr></table>' };
                   1466:     return $template;
                   1467: 
1.44      bowersj2 1468: }
1.37      matthew  1469: 
1.180     matthew  1470: ###############################################################
                   1471: ###############################################################
                   1472: 
1.45      matthew  1473: =pod
                   1474: 
1.648     raeburn  1475: =item * &change_content_javascript():
1.256     matthew  1476: 
                   1477: This and the next function allow you to create small sections of an
                   1478: otherwise static HTML page that you can update on the fly with
                   1479: Javascript, even in Netscape 4.
                   1480: 
                   1481: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1482: must be written to the HTML page once. It will prove the Javascript
                   1483: function "change(name, content)". Calling the change function with the
                   1484: name of the section 
                   1485: you want to update, matching the name passed to C<changable_area>, and
                   1486: the new content you want to put in there, will put the content into
                   1487: that area.
                   1488: 
                   1489: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1490: to contain room for the original contents. You need to "make space"
                   1491: for whatever changes you wish to make, and be B<sure> to check your
                   1492: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1493: it's adequate for updating a one-line status display, but little more.
                   1494: This script will set the space to 100% width, so you only need to
                   1495: worry about height in Netscape 4.
                   1496: 
                   1497: Modern browsers are much less limiting, and if you can commit to the
                   1498: user not using Netscape 4, this feature may be used freely with
                   1499: pretty much any HTML.
                   1500: 
                   1501: =cut
                   1502: 
                   1503: sub change_content_javascript {
                   1504:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1505:     if ($env{'browser.type'} eq 'netscape' &&
                   1506: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1507: 	return (<<NETSCAPE4);
                   1508: 	function change(name, content) {
                   1509: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1510: 	    doc.open();
                   1511: 	    doc.write(content);
                   1512: 	    doc.close();
                   1513: 	}
                   1514: NETSCAPE4
                   1515:     } else {
                   1516: 	# Otherwise, we need to use semi-standards-compliant code
                   1517: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1518: 	# is really scary, and every useful browser supports it
                   1519: 	return (<<DOMBASED);
                   1520: 	function change(name, content) {
                   1521: 	    element = document.getElementById(name);
                   1522: 	    element.innerHTML = content;
                   1523: 	}
                   1524: DOMBASED
                   1525:     }
                   1526: }
                   1527: 
                   1528: =pod
                   1529: 
1.648     raeburn  1530: =item * &changable_area($name,$origContent):
1.256     matthew  1531: 
                   1532: This provides a "changable area" that can be modified on the fly via
                   1533: the Javascript code provided in C<change_content_javascript>. $name is
                   1534: the name you will use to reference the area later; do not repeat the
                   1535: same name on a given HTML page more then once. $origContent is what
                   1536: the area will originally contain, which can be left blank.
                   1537: 
                   1538: =cut
                   1539: 
                   1540: sub changable_area {
                   1541:     my ($name, $origContent) = @_;
                   1542: 
1.258     albertel 1543:     if ($env{'browser.type'} eq 'netscape' &&
                   1544: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1545: 	# If this is netscape 4, we need to use the Layer tag
                   1546: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1547:     } else {
                   1548: 	return "<span id='$name'>$origContent</span>";
                   1549:     }
                   1550: }
                   1551: 
                   1552: =pod
                   1553: 
1.648     raeburn  1554: =item * &viewport_geometry_js 
1.590     raeburn  1555: 
                   1556: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1557: 
                   1558: =cut
                   1559: 
                   1560: 
                   1561: sub viewport_geometry_js { 
                   1562:     return <<"GEOMETRY";
                   1563: var Geometry = {};
                   1564: function init_geometry() {
                   1565:     if (Geometry.init) { return };
                   1566:     Geometry.init=1;
                   1567:     if (window.innerHeight) {
                   1568:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1569:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1570:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1571:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1572:     }
                   1573:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1574:         Geometry.getViewportHeight =
                   1575:             function() { return document.documentElement.clientHeight; };
                   1576:         Geometry.getViewportWidth =
                   1577:             function() { return document.documentElement.clientWidth; };
                   1578: 
                   1579:         Geometry.getHorizontalScroll =
                   1580:             function() { return document.documentElement.scrollLeft; };
                   1581:         Geometry.getVerticalScroll =
                   1582:             function() { return document.documentElement.scrollTop; };
                   1583:     }
                   1584:     else if (document.body.clientHeight) {
                   1585:         Geometry.getViewportHeight =
                   1586:             function() { return document.body.clientHeight; };
                   1587:         Geometry.getViewportWidth =
                   1588:             function() { return document.body.clientWidth; };
                   1589:         Geometry.getHorizontalScroll =
                   1590:             function() { return document.body.scrollLeft; };
                   1591:         Geometry.getVerticalScroll =
                   1592:             function() { return document.body.scrollTop; };
                   1593:     }
                   1594: }
                   1595: 
                   1596: GEOMETRY
                   1597: }
                   1598: 
                   1599: =pod
                   1600: 
1.648     raeburn  1601: =item * &viewport_size_js()
1.590     raeburn  1602: 
                   1603: 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. 
                   1604: 
                   1605: =cut
                   1606: 
                   1607: sub viewport_size_js {
                   1608:     my $geometry = &viewport_geometry_js();
                   1609:     return <<"DIMS";
                   1610: 
                   1611: $geometry
                   1612: 
                   1613: function getViewportDims(width,height) {
                   1614:     init_geometry();
                   1615:     width.value = Geometry.getViewportWidth();
                   1616:     height.value = Geometry.getViewportHeight();
                   1617:     return;
                   1618: }
                   1619: 
                   1620: DIMS
                   1621: }
                   1622: 
                   1623: =pod
                   1624: 
1.648     raeburn  1625: =item * &resize_textarea_js()
1.565     albertel 1626: 
                   1627: emits the needed javascript to resize a textarea to be as big as possible
                   1628: 
                   1629: creates a function resize_textrea that takes two IDs first should be
                   1630: the id of the element to resize, second should be the id of a div that
                   1631: surrounds everything that comes after the textarea, this routine needs
                   1632: to be attached to the <body> for the onload and onresize events.
                   1633: 
1.648     raeburn  1634: =back
1.565     albertel 1635: 
                   1636: =cut
                   1637: 
                   1638: sub resize_textarea_js {
1.590     raeburn  1639:     my $geometry = &viewport_geometry_js();
1.565     albertel 1640:     return <<"RESIZE";
                   1641:     <script type="text/javascript">
1.824     bisitz   1642: // <![CDATA[
1.590     raeburn  1643: $geometry
1.565     albertel 1644: 
1.588     albertel 1645: function getX(element) {
                   1646:     var x = 0;
                   1647:     while (element) {
                   1648: 	x += element.offsetLeft;
                   1649: 	element = element.offsetParent;
                   1650:     }
                   1651:     return x;
                   1652: }
                   1653: function getY(element) {
                   1654:     var y = 0;
                   1655:     while (element) {
                   1656: 	y += element.offsetTop;
                   1657: 	element = element.offsetParent;
                   1658:     }
                   1659:     return y;
                   1660: }
                   1661: 
                   1662: 
1.565     albertel 1663: function resize_textarea(textarea_id,bottom_id) {
                   1664:     init_geometry();
                   1665:     var textarea        = document.getElementById(textarea_id);
                   1666:     //alert(textarea);
                   1667: 
1.588     albertel 1668:     var textarea_top    = getY(textarea);
1.565     albertel 1669:     var textarea_height = textarea.offsetHeight;
                   1670:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1671:     var bottom_top      = getY(bottom);
1.565     albertel 1672:     var bottom_height   = bottom.offsetHeight;
                   1673:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1674:     var fudge           = 23;
1.565     albertel 1675:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1676:     if (new_height < 300) {
                   1677: 	new_height = 300;
                   1678:     }
                   1679:     textarea.style.height=new_height+'px';
                   1680: }
1.824     bisitz   1681: // ]]>
1.565     albertel 1682: </script>
                   1683: RESIZE
                   1684: 
                   1685: }
                   1686: 
                   1687: =pod
                   1688: 
1.256     matthew  1689: =head1 Excel and CSV file utility routines
                   1690: 
                   1691: =over 4
                   1692: 
                   1693: =cut
                   1694: 
                   1695: ###############################################################
                   1696: ###############################################################
                   1697: 
                   1698: =pod
                   1699: 
1.648     raeburn  1700: =item * &csv_translate($text) 
1.37      matthew  1701: 
1.185     www      1702: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1703: format.
                   1704: 
                   1705: =cut
                   1706: 
1.180     matthew  1707: ###############################################################
                   1708: ###############################################################
1.37      matthew  1709: sub csv_translate {
                   1710:     my $text = shift;
                   1711:     $text =~ s/\"/\"\"/g;
1.209     albertel 1712:     $text =~ s/\n/ /g;
1.37      matthew  1713:     return $text;
                   1714: }
1.180     matthew  1715: 
                   1716: ###############################################################
                   1717: ###############################################################
                   1718: 
                   1719: =pod
                   1720: 
1.648     raeburn  1721: =item * &define_excel_formats()
1.180     matthew  1722: 
                   1723: Define some commonly used Excel cell formats.
                   1724: 
                   1725: Currently supported formats:
                   1726: 
                   1727: =over 4
                   1728: 
                   1729: =item header
                   1730: 
                   1731: =item bold
                   1732: 
                   1733: =item h1
                   1734: 
                   1735: =item h2
                   1736: 
                   1737: =item h3
                   1738: 
1.256     matthew  1739: =item h4
                   1740: 
                   1741: =item i
                   1742: 
1.180     matthew  1743: =item date
                   1744: 
                   1745: =back
                   1746: 
                   1747: Inputs: $workbook
                   1748: 
                   1749: Returns: $format, a hash reference.
                   1750: 
1.1057    foxr     1751: 
1.180     matthew  1752: =cut
                   1753: 
                   1754: ###############################################################
                   1755: ###############################################################
                   1756: sub define_excel_formats {
                   1757:     my ($workbook) = @_;
                   1758:     my $format;
                   1759:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1760:                                                 bottom    => 1,
                   1761:                                                 align     => 'center');
                   1762:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1763:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1764:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1765:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1766:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1767:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1768:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1769:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1770:     return $format;
                   1771: }
                   1772: 
                   1773: ###############################################################
                   1774: ###############################################################
1.113     bowersj2 1775: 
                   1776: =pod
                   1777: 
1.648     raeburn  1778: =item * &create_workbook()
1.255     matthew  1779: 
                   1780: Create an Excel worksheet.  If it fails, output message on the
                   1781: request object and return undefs.
                   1782: 
                   1783: Inputs: Apache request object
                   1784: 
                   1785: Returns (undef) on failure, 
                   1786:     Excel worksheet object, scalar with filename, and formats 
                   1787:     from &Apache::loncommon::define_excel_formats on success
                   1788: 
                   1789: =cut
                   1790: 
                   1791: ###############################################################
                   1792: ###############################################################
                   1793: sub create_workbook {
                   1794:     my ($r) = @_;
                   1795:         #
                   1796:     # Create the excel spreadsheet
                   1797:     my $filename = '/prtspool/'.
1.258     albertel 1798:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1799:         time.'_'.rand(1000000000).'.xls';
                   1800:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1801:     if (! defined($workbook)) {
                   1802:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1803:         $r->print(
                   1804:             '<p class="LC_error">'
                   1805:            .&mt('Problems occurred in creating the new Excel file.')
                   1806:            .' '.&mt('This error has been logged.')
                   1807:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1808:            .'</p>'
                   1809:         );
1.255     matthew  1810:         return (undef);
                   1811:     }
                   1812:     #
1.1014    foxr     1813:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1814:     #
                   1815:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1816:     return ($workbook,$filename,$format);
                   1817: }
                   1818: 
                   1819: ###############################################################
                   1820: ###############################################################
                   1821: 
                   1822: =pod
                   1823: 
1.648     raeburn  1824: =item * &create_text_file()
1.113     bowersj2 1825: 
1.542     raeburn  1826: Create a file to write to and eventually make available to the user.
1.256     matthew  1827: If file creation fails, outputs an error message on the request object and 
                   1828: return undefs.
1.113     bowersj2 1829: 
1.256     matthew  1830: Inputs: Apache request object, and file suffix
1.113     bowersj2 1831: 
1.256     matthew  1832: Returns (undef) on failure, 
                   1833:     Filehandle and filename on success.
1.113     bowersj2 1834: 
                   1835: =cut
                   1836: 
1.256     matthew  1837: ###############################################################
                   1838: ###############################################################
                   1839: sub create_text_file {
                   1840:     my ($r,$suffix) = @_;
                   1841:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1842:     my $fh;
                   1843:     my $filename = '/prtspool/'.
1.258     albertel 1844:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1845:         time.'_'.rand(1000000000).'.'.$suffix;
                   1846:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1847:     if (! defined($fh)) {
                   1848:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1849:         $r->print(
                   1850:             '<p class="LC_error">'
                   1851:            .&mt('Problems occurred in creating the output file.')
                   1852:            .' '.&mt('This error has been logged.')
                   1853:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1854:            .'</p>'
                   1855:         );
1.113     bowersj2 1856:     }
1.256     matthew  1857:     return ($fh,$filename)
1.113     bowersj2 1858: }
                   1859: 
                   1860: 
1.256     matthew  1861: =pod 
1.113     bowersj2 1862: 
                   1863: =back
                   1864: 
                   1865: =cut
1.37      matthew  1866: 
                   1867: ###############################################################
1.33      matthew  1868: ##        Home server <option> list generating code          ##
                   1869: ###############################################################
1.35      matthew  1870: 
1.169     www      1871: # ------------------------------------------
                   1872: 
                   1873: sub domain_select {
                   1874:     my ($name,$value,$multiple)=@_;
                   1875:     my %domains=map { 
1.514     albertel 1876: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1877:     } &Apache::lonnet::all_domains();
1.169     www      1878:     if ($multiple) {
                   1879: 	$domains{''}=&mt('Any domain');
1.550     albertel 1880: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1881: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1882:     } else {
1.550     albertel 1883: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1884: 	return &select_form($name,$value,\%domains);
1.169     www      1885:     }
                   1886: }
                   1887: 
1.282     albertel 1888: #-------------------------------------------
                   1889: 
                   1890: =pod
                   1891: 
1.519     raeburn  1892: =head1 Routines for form select boxes
                   1893: 
                   1894: =over 4
                   1895: 
1.648     raeburn  1896: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1897: 
                   1898: Returns a string containing a <select> element int multiple mode
                   1899: 
                   1900: 
                   1901: Args:
                   1902:   $name - name of the <select> element
1.506     raeburn  1903:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1904:   $size - number of rows long the select element is
1.283     albertel 1905:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1906:           (shown text should already have been &mt())
1.506     raeburn  1907:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1908: 
1.282     albertel 1909: =cut
                   1910: 
                   1911: #-------------------------------------------
1.169     www      1912: sub multiple_select_form {
1.284     albertel 1913:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1914:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1915:     my $output='';
1.191     matthew  1916:     if (! defined($size)) {
                   1917:         $size = 4;
1.283     albertel 1918:         if (scalar(keys(%$hash))<4) {
                   1919:             $size = scalar(keys(%$hash));
1.191     matthew  1920:         }
                   1921:     }
1.734     bisitz   1922:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1923:     my @order;
1.506     raeburn  1924:     if (ref($order) eq 'ARRAY')  {
                   1925:         @order = @{$order};
                   1926:     } else {
                   1927:         @order = sort(keys(%$hash));
1.501     banghart 1928:     }
                   1929:     if (exists($$hash{'select_form_order'})) {
                   1930:         @order = @{$$hash{'select_form_order'}};
                   1931:     }
                   1932:         
1.284     albertel 1933:     foreach my $key (@order) {
1.356     albertel 1934:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1935:         $output.='selected="selected" ' if ($selected{$key});
                   1936:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1937:     }
                   1938:     $output.="</select>\n";
                   1939:     return $output;
                   1940: }
                   1941: 
1.88      www      1942: #-------------------------------------------
                   1943: 
                   1944: =pod
                   1945: 
1.970     raeburn  1946: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1947: 
                   1948: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1949: allow a user to select options from a ref to a hash containing:
                   1950: option_name => displayed text. An optional $onchange can include
                   1951: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   1952: 
1.88      www      1953: See lonrights.pm for an example invocation and use.
                   1954: 
                   1955: =cut
                   1956: 
                   1957: #-------------------------------------------
                   1958: sub select_form {
1.970     raeburn  1959:     my ($def,$name,$hashref,$onchange) = @_;
                   1960:     return unless (ref($hashref) eq 'HASH');
                   1961:     if ($onchange) {
                   1962:         $onchange = ' onchange="'.$onchange.'"';
                   1963:     }
                   1964:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 1965:     my @keys;
1.970     raeburn  1966:     if (exists($hashref->{'select_form_order'})) {
                   1967: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 1968:     } else {
1.970     raeburn  1969: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 1970:     }
1.356     albertel 1971:     foreach my $key (@keys) {
                   1972:         $selectform.=
                   1973: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   1974:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  1975:                 ">".$hashref->{$key}."</option>\n";
1.88      www      1976:     }
                   1977:     $selectform.="</select>";
                   1978:     return $selectform;
                   1979: }
                   1980: 
1.475     www      1981: # For display filters
                   1982: 
                   1983: sub display_filter {
                   1984:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      1985:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.714     bisitz   1986:     return '<span class="LC_nobreak"><label>'.&mt('Records [_1]',
1.475     www      1987: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   1988: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   1989: 	   '</label></span> <span class="LC_nobreak">'.
1.475     www      1990:            &mt('Filter [_1]',
1.477     www      1991: 	   &select_form($env{'form.displayfilter'},
                   1992: 			'displayfilter',
1.970     raeburn  1993: 			{'currentfolder' => 'Current folder/page',
1.477     www      1994: 			 'containing' => 'Containing phrase',
1.970     raeburn  1995: 			 'none' => 'None'})).
1.714     bisitz   1996: 			 '<input type="text" name="containingphrase" size="30" value="'.&HTML::Entities::encode($env{'form.containingphrase'}).'" /></span>';
1.475     www      1997: }
                   1998: 
1.167     www      1999: sub gradeleveldescription {
                   2000:     my $gradelevel=shift;
                   2001:     my %gradelevels=(0 => 'Not specified',
                   2002: 		     1 => 'Grade 1',
                   2003: 		     2 => 'Grade 2',
                   2004: 		     3 => 'Grade 3',
                   2005: 		     4 => 'Grade 4',
                   2006: 		     5 => 'Grade 5',
                   2007: 		     6 => 'Grade 6',
                   2008: 		     7 => 'Grade 7',
                   2009: 		     8 => 'Grade 8',
                   2010: 		     9 => 'Grade 9',
                   2011: 		     10 => 'Grade 10',
                   2012: 		     11 => 'Grade 11',
                   2013: 		     12 => 'Grade 12',
                   2014: 		     13 => 'Grade 13',
                   2015: 		     14 => '100 Level',
                   2016: 		     15 => '200 Level',
                   2017: 		     16 => '300 Level',
                   2018: 		     17 => '400 Level',
                   2019: 		     18 => 'Graduate Level');
                   2020:     return &mt($gradelevels{$gradelevel});
                   2021: }
                   2022: 
1.163     www      2023: sub select_level_form {
                   2024:     my ($deflevel,$name)=@_;
                   2025:     unless ($deflevel) { $deflevel=0; }
1.167     www      2026:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2027:     for (my $i=0; $i<=18; $i++) {
                   2028:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2029:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2030:                 ">".&gradeleveldescription($i)."</option>\n";
                   2031:     }
                   2032:     $selectform.="</select>";
                   2033:     return $selectform;
1.163     www      2034: }
1.167     www      2035: 
1.35      matthew  2036: #-------------------------------------------
                   2037: 
1.45      matthew  2038: =pod
                   2039: 
1.910     raeburn  2040: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms)
1.35      matthew  2041: 
                   2042: Returns a string containing a <select name='$name' size='1'> form to 
                   2043: allow a user to select the domain to preform an operation in.  
                   2044: See loncreateuser.pm for an example invocation and use.
                   2045: 
1.90      www      2046: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2047: selected");
                   2048: 
1.743     raeburn  2049: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2050: 
1.910     raeburn  2051: 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.
                   2052: 
                   2053: The optional $incdoms is a reference to an array of domains which will be the only available options. 
1.563     raeburn  2054: 
1.35      matthew  2055: =cut
                   2056: 
                   2057: #-------------------------------------------
1.34      matthew  2058: sub select_dom_form {
1.910     raeburn  2059:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms) = @_;
1.872     raeburn  2060:     if ($onchange) {
1.874     raeburn  2061:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2062:     }
1.910     raeburn  2063:     my @domains;
                   2064:     if (ref($incdoms) eq 'ARRAY') {
                   2065:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2066:     } else {
                   2067:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2068:     }
1.90      www      2069:     if ($includeempty) { @domains=('',@domains); }
1.743     raeburn  2070:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2071:     foreach my $dom (@domains) {
                   2072:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2073:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2074:         if ($showdomdesc) {
                   2075:             if ($dom ne '') {
                   2076:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2077:                 if ($domdesc ne '') {
                   2078:                     $selectdomain .= ' ('.$domdesc.')';
                   2079:                 }
                   2080:             } 
                   2081:         }
                   2082:         $selectdomain .= "</option>\n";
1.34      matthew  2083:     }
                   2084:     $selectdomain.="</select>";
                   2085:     return $selectdomain;
                   2086: }
                   2087: 
1.35      matthew  2088: #-------------------------------------------
                   2089: 
1.45      matthew  2090: =pod
                   2091: 
1.648     raeburn  2092: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2093: 
1.586     raeburn  2094: input: 4 arguments (two required, two optional) - 
                   2095:     $domain - domain of new user
                   2096:     $name - name of form element
                   2097:     $default - Value of 'default' causes a default item to be first 
                   2098:                             option, and selected by default. 
                   2099:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2100:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2101: output: returns 2 items: 
1.586     raeburn  2102: (a) form element which contains either:
                   2103:    (i) <select name="$name">
                   2104:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2105:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2106:        </select>
                   2107:        form item if there are multiple library servers in $domain, or
                   2108:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2109:        if there is only one library server in $domain.
                   2110: 
                   2111: (b) number of library servers found.
                   2112: 
                   2113: See loncreateuser.pm for example of use.
1.35      matthew  2114: 
                   2115: =cut
                   2116: 
                   2117: #-------------------------------------------
1.586     raeburn  2118: sub home_server_form_item {
                   2119:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2120:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2121:     my $result;
                   2122:     my $numlib = keys(%servers);
                   2123:     if ($numlib > 1) {
                   2124:         $result .= '<select name="'.$name.'" />'."\n";
                   2125:         if ($default) {
1.804     bisitz   2126:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2127:                        '</option>'."\n";
                   2128:         }
                   2129:         foreach my $hostid (sort(keys(%servers))) {
                   2130:             $result.= '<option value="'.$hostid.'">'.
                   2131: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2132:         }
                   2133:         $result .= '</select>'."\n";
                   2134:     } elsif ($numlib == 1) {
                   2135:         my $hostid;
                   2136:         foreach my $item (keys(%servers)) {
                   2137:             $hostid = $item;
                   2138:         }
                   2139:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2140:                    $hostid.'" />';
                   2141:                    if (!$hide) {
                   2142:                        $result .= $hostid.' '.$servers{$hostid};
                   2143:                    }
                   2144:                    $result .= "\n";
                   2145:     } elsif ($default) {
                   2146:         $result .= '<input type="hidden" name="'.$name.
                   2147:                    '" value="default" />';
                   2148:                    if (!$hide) {
                   2149:                        $result .= &mt('default');
                   2150:                    }
                   2151:                    $result .= "\n";
1.33      matthew  2152:     }
1.586     raeburn  2153:     return ($result,$numlib);
1.33      matthew  2154: }
1.112     bowersj2 2155: 
                   2156: =pod
                   2157: 
1.534     albertel 2158: =back 
                   2159: 
1.112     bowersj2 2160: =cut
1.87      matthew  2161: 
                   2162: ###############################################################
1.112     bowersj2 2163: ##                  Decoding User Agent                      ##
1.87      matthew  2164: ###############################################################
                   2165: 
                   2166: =pod
                   2167: 
1.112     bowersj2 2168: =head1 Decoding the User Agent
                   2169: 
                   2170: =over 4
                   2171: 
                   2172: =item * &decode_user_agent()
1.87      matthew  2173: 
                   2174: Inputs: $r
                   2175: 
                   2176: Outputs:
                   2177: 
                   2178: =over 4
                   2179: 
1.112     bowersj2 2180: =item * $httpbrowser
1.87      matthew  2181: 
1.112     bowersj2 2182: =item * $clientbrowser
1.87      matthew  2183: 
1.112     bowersj2 2184: =item * $clientversion
1.87      matthew  2185: 
1.112     bowersj2 2186: =item * $clientmathml
1.87      matthew  2187: 
1.112     bowersj2 2188: =item * $clientunicode
1.87      matthew  2189: 
1.112     bowersj2 2190: =item * $clientos
1.87      matthew  2191: 
                   2192: =back
                   2193: 
1.157     matthew  2194: =back 
                   2195: 
1.87      matthew  2196: =cut
                   2197: 
                   2198: ###############################################################
                   2199: ###############################################################
                   2200: sub decode_user_agent {
1.247     albertel 2201:     my ($r)=@_;
1.87      matthew  2202:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2203:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2204:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2205:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2206:     my $clientbrowser='unknown';
                   2207:     my $clientversion='0';
                   2208:     my $clientmathml='';
                   2209:     my $clientunicode='0';
                   2210:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2211:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2212: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2213: 	    $clientbrowser=$bname;
                   2214:             $httpbrowser=~/$vreg/i;
                   2215: 	    $clientversion=$1;
                   2216:             $clientmathml=($clientversion>=$minv);
                   2217:             $clientunicode=($clientversion>=$univ);
                   2218: 	}
                   2219:     }
                   2220:     my $clientos='unknown';
                   2221:     if (($httpbrowser=~/linux/i) ||
                   2222:         ($httpbrowser=~/unix/i) ||
                   2223:         ($httpbrowser=~/ux/i) ||
                   2224:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2225:     if (($httpbrowser=~/vax/i) ||
                   2226:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2227:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2228:     if (($httpbrowser=~/mac/i) ||
                   2229:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2230:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2231:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
                   2232:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   2233:             $clientunicode,$clientos,);
                   2234: }
                   2235: 
1.32      matthew  2236: ###############################################################
                   2237: ##    Authentication changing form generation subroutines    ##
                   2238: ###############################################################
                   2239: ##
                   2240: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2241: ## hash, and have reasonable default values.
                   2242: ##
                   2243: ##    formname = the name given in the <form> tag.
1.35      matthew  2244: #-------------------------------------------
                   2245: 
1.45      matthew  2246: =pod
                   2247: 
1.112     bowersj2 2248: =head1 Authentication Routines
                   2249: 
                   2250: =over 4
                   2251: 
1.648     raeburn  2252: =item * &authform_xxxxxx()
1.35      matthew  2253: 
                   2254: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2255: handle some of the conveniences required for authentication forms.  
                   2256: This is not an optimal method, but it works.  
                   2257: 
                   2258: =over 4
                   2259: 
1.112     bowersj2 2260: =item * authform_header
1.35      matthew  2261: 
1.112     bowersj2 2262: =item * authform_authorwarning
1.35      matthew  2263: 
1.112     bowersj2 2264: =item * authform_nochange
1.35      matthew  2265: 
1.112     bowersj2 2266: =item * authform_kerberos
1.35      matthew  2267: 
1.112     bowersj2 2268: =item * authform_internal
1.35      matthew  2269: 
1.112     bowersj2 2270: =item * authform_filesystem
1.35      matthew  2271: 
                   2272: =back
                   2273: 
1.648     raeburn  2274: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2275: 
1.35      matthew  2276: =cut
                   2277: 
                   2278: #-------------------------------------------
1.32      matthew  2279: sub authform_header{  
                   2280:     my %in = (
                   2281:         formname => 'cu',
1.80      albertel 2282:         kerb_def_dom => '',
1.32      matthew  2283:         @_,
                   2284:     );
                   2285:     $in{'formname'} = 'document.' . $in{'formname'};
                   2286:     my $result='';
1.80      albertel 2287: 
                   2288: #---------------------------------------------- Code for upper case translation
                   2289:     my $Javascript_toUpperCase;
                   2290:     unless ($in{kerb_def_dom}) {
                   2291:         $Javascript_toUpperCase =<<"END";
                   2292:         switch (choice) {
                   2293:            case 'krb': currentform.elements[choicearg].value =
                   2294:                currentform.elements[choicearg].value.toUpperCase();
                   2295:                break;
                   2296:            default:
                   2297:         }
                   2298: END
                   2299:     } else {
                   2300:         $Javascript_toUpperCase = "";
                   2301:     }
                   2302: 
1.165     raeburn  2303:     my $radioval = "'nochange'";
1.591     raeburn  2304:     if (defined($in{'curr_authtype'})) {
                   2305:         if ($in{'curr_authtype'} ne '') {
                   2306:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2307:         }
1.174     matthew  2308:     }
1.165     raeburn  2309:     my $argfield = 'null';
1.591     raeburn  2310:     if (defined($in{'mode'})) {
1.165     raeburn  2311:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2312:             if (defined($in{'curr_autharg'})) {
                   2313:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2314:                     $argfield = "'$in{'curr_autharg'}'";
                   2315:                 }
                   2316:             }
                   2317:         }
                   2318:     }
                   2319: 
1.32      matthew  2320:     $result.=<<"END";
                   2321: var current = new Object();
1.165     raeburn  2322: current.radiovalue = $radioval;
                   2323: current.argfield = $argfield;
1.32      matthew  2324: 
                   2325: function changed_radio(choice,currentform) {
                   2326:     var choicearg = choice + 'arg';
                   2327:     // If a radio button in changed, we need to change the argfield
                   2328:     if (current.radiovalue != choice) {
                   2329:         current.radiovalue = choice;
                   2330:         if (current.argfield != null) {
                   2331:             currentform.elements[current.argfield].value = '';
                   2332:         }
                   2333:         if (choice == 'nochange') {
                   2334:             current.argfield = null;
                   2335:         } else {
                   2336:             current.argfield = choicearg;
                   2337:             switch(choice) {
                   2338:                 case 'krb': 
                   2339:                     currentform.elements[current.argfield].value = 
                   2340:                         "$in{'kerb_def_dom'}";
                   2341:                 break;
                   2342:               default:
                   2343:                 break;
                   2344:             }
                   2345:         }
                   2346:     }
                   2347:     return;
                   2348: }
1.22      www      2349: 
1.32      matthew  2350: function changed_text(choice,currentform) {
                   2351:     var choicearg = choice + 'arg';
                   2352:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2353:         $Javascript_toUpperCase
1.32      matthew  2354:         // clear old field
                   2355:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2356:             currentform.elements[current.argfield].value = '';
                   2357:         }
                   2358:         current.argfield = choicearg;
                   2359:     }
                   2360:     set_auth_radio_buttons(choice,currentform);
                   2361:     return;
1.20      www      2362: }
1.32      matthew  2363: 
                   2364: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2365:     var numauthchoices = currentform.login.length;
                   2366:     if (typeof numauthchoices  == "undefined") {
                   2367:         return;
                   2368:     } 
1.32      matthew  2369:     var i=0;
1.986     raeburn  2370:     while (i < numauthchoices) {
1.32      matthew  2371:         if (currentform.login[i].value == newvalue) { break; }
                   2372:         i++;
                   2373:     }
1.986     raeburn  2374:     if (i == numauthchoices) {
1.32      matthew  2375:         return;
                   2376:     }
                   2377:     current.radiovalue = newvalue;
                   2378:     currentform.login[i].checked = true;
                   2379:     return;
                   2380: }
                   2381: END
                   2382:     return $result;
                   2383: }
                   2384: 
                   2385: sub authform_authorwarning{
                   2386:     my $result='';
1.144     matthew  2387:     $result='<i>'.
                   2388:         &mt('As a general rule, only authors or co-authors should be '.
                   2389:             'filesystem authenticated '.
                   2390:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2391:     return $result;
                   2392: }
                   2393: 
                   2394: sub authform_nochange{  
                   2395:     my %in = (
                   2396:               formname => 'document.cu',
                   2397:               kerb_def_dom => 'MSU.EDU',
                   2398:               @_,
                   2399:           );
1.586     raeburn  2400:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'}); 
                   2401:     my $result;
                   2402:     if (keys(%can_assign) == 0) {
                   2403:         $result = &mt('Under you current role you are not permitted to change login settings for this user');  
                   2404:     } else {
                   2405:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2406:                   '<input type="radio" name="login" value="nochange" '.
                   2407:                   'checked="checked" onclick="'.
1.281     albertel 2408:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2409: 	    '</label>';
1.586     raeburn  2410:     }
1.32      matthew  2411:     return $result;
                   2412: }
                   2413: 
1.591     raeburn  2414: sub authform_kerberos {
1.32      matthew  2415:     my %in = (
                   2416:               formname => 'document.cu',
                   2417:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2418:               kerb_def_auth => 'krb4',
1.32      matthew  2419:               @_,
                   2420:               );
1.586     raeburn  2421:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2422:         $autharg,$jscall);
                   2423:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.80      albertel 2424:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2425:        $check5 = ' checked="checked"';
1.80      albertel 2426:     } else {
1.772     bisitz   2427:        $check4 = ' checked="checked"';
1.80      albertel 2428:     }
1.165     raeburn  2429:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2430:     if (defined($in{'curr_authtype'})) {
                   2431:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2432:             $krbcheck = ' checked="checked"';
1.623     raeburn  2433:             if (defined($in{'mode'})) {
                   2434:                 if ($in{'mode'} eq 'modifyuser') {
                   2435:                     $krbcheck = '';
                   2436:                 }
                   2437:             }
1.591     raeburn  2438:             if (defined($in{'curr_kerb_ver'})) {
                   2439:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2440:                     $check5 = ' checked="checked"';
1.591     raeburn  2441:                     $check4 = '';
                   2442:                 } else {
1.772     bisitz   2443:                     $check4 = ' checked="checked"';
1.591     raeburn  2444:                     $check5 = '';
                   2445:                 }
1.586     raeburn  2446:             }
1.591     raeburn  2447:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2448:                 $krbarg = $in{'curr_autharg'};
                   2449:             }
1.586     raeburn  2450:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2451:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2452:                     $result = 
                   2453:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2454:         $in{'curr_autharg'},$krbver);
                   2455:                 } else {
                   2456:                     $result =
                   2457:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2458:                 }
                   2459:                 return $result; 
                   2460:             }
                   2461:         }
                   2462:     } else {
                   2463:         if ($authnum == 1) {
1.784     bisitz   2464:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2465:         }
                   2466:     }
1.586     raeburn  2467:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2468:         return;
1.587     raeburn  2469:     } elsif ($authtype eq '') {
1.591     raeburn  2470:         if (defined($in{'mode'})) {
1.587     raeburn  2471:             if ($in{'mode'} eq 'modifycourse') {
                   2472:                 if ($authnum == 1) {
1.784     bisitz   2473:                     $authtype = '<input type="hidden" name="login" value="krb" />';
1.587     raeburn  2474:                 }
                   2475:             }
                   2476:         }
1.586     raeburn  2477:     }
                   2478:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2479:     if ($authtype eq '') {
                   2480:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2481:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2482:                     $krbcheck.' />';
                   2483:     }
                   2484:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
                   2485:         ($can_assign{'krb4'} && !$can_assign{'krb5'} && 
                   2486:          $in{'curr_authtype'} eq 'krb5') ||
                   2487:         (!$can_assign{'krb4'} && $can_assign{'krb5'} && 
                   2488:          $in{'curr_authtype'} eq 'krb4')) {
                   2489:         $result .= &mt
1.144     matthew  2490:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2491:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2492:          '<label>'.$authtype,
1.281     albertel 2493:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2494:              'value="'.$krbarg.'" '.
1.144     matthew  2495:              'onchange="'.$jscall.'" />',
1.281     albertel 2496:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2497:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2498: 	 '</label>');
1.586     raeburn  2499:     } elsif ($can_assign{'krb4'}) {
                   2500:         $result .= &mt
                   2501:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2502:          '[_3] Version 4 [_4]',
                   2503:          '<label>'.$authtype,
                   2504:          '</label><input type="text" size="10" name="krbarg" '.
                   2505:              'value="'.$krbarg.'" '.
                   2506:              'onchange="'.$jscall.'" />',
                   2507:          '<label><input type="hidden" name="krbver" value="4" />',
                   2508:          '</label>');
                   2509:     } elsif ($can_assign{'krb5'}) {
                   2510:         $result .= &mt
                   2511:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2512:          '[_3] Version 5 [_4]',
                   2513:          '<label>'.$authtype,
                   2514:          '</label><input type="text" size="10" name="krbarg" '.
                   2515:              'value="'.$krbarg.'" '.
                   2516:              'onchange="'.$jscall.'" />',
                   2517:          '<label><input type="hidden" name="krbver" value="5" />',
                   2518:          '</label>');
                   2519:     }
1.32      matthew  2520:     return $result;
                   2521: }
                   2522: 
                   2523: sub authform_internal{  
1.586     raeburn  2524:     my %in = (
1.32      matthew  2525:                 formname => 'document.cu',
                   2526:                 kerb_def_dom => 'MSU.EDU',
                   2527:                 @_,
                   2528:                 );
1.586     raeburn  2529:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
                   2530:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2531:     if (defined($in{'curr_authtype'})) {
                   2532:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2533:             if ($can_assign{'int'}) {
1.772     bisitz   2534:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2535:                 if (defined($in{'mode'})) {
                   2536:                     if ($in{'mode'} eq 'modifyuser') {
                   2537:                         $intcheck = '';
                   2538:                     }
                   2539:                 }
1.591     raeburn  2540:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2541:                     $intarg = $in{'curr_autharg'};
                   2542:                 }
                   2543:             } else {
                   2544:                 $result = &mt('Currently internally authenticated.');
                   2545:                 return $result;
1.165     raeburn  2546:             }
                   2547:         }
1.586     raeburn  2548:     } else {
                   2549:         if ($authnum == 1) {
1.784     bisitz   2550:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2551:         }
                   2552:     }
                   2553:     if (!$can_assign{'int'}) {
                   2554:         return;
1.587     raeburn  2555:     } elsif ($authtype eq '') {
1.591     raeburn  2556:         if (defined($in{'mode'})) {
1.587     raeburn  2557:             if ($in{'mode'} eq 'modifycourse') {
                   2558:                 if ($authnum == 1) {
1.784     bisitz   2559:                     $authtype = '<input type="hidden" name="login" value="int" />';
1.587     raeburn  2560:                 }
                   2561:             }
                   2562:         }
1.165     raeburn  2563:     }
1.586     raeburn  2564:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2565:     if ($authtype eq '') {
                   2566:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2567:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2568:     }
1.605     bisitz   2569:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2570:                $intarg.'" onchange="'.$jscall.'" />';
                   2571:     $result = &mt
1.144     matthew  2572:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2573:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2574:     $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  2575:     return $result;
                   2576: }
                   2577: 
                   2578: sub authform_local{  
                   2579:     my %in = (
                   2580:               formname => 'document.cu',
                   2581:               kerb_def_dom => 'MSU.EDU',
                   2582:               @_,
                   2583:               );
1.586     raeburn  2584:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
                   2585:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2586:     if (defined($in{'curr_authtype'})) {
                   2587:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2588:             if ($can_assign{'loc'}) {
1.772     bisitz   2589:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2590:                 if (defined($in{'mode'})) {
                   2591:                     if ($in{'mode'} eq 'modifyuser') {
                   2592:                         $loccheck = '';
                   2593:                     }
                   2594:                 }
1.591     raeburn  2595:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2596:                     $locarg = $in{'curr_autharg'};
                   2597:                 }
                   2598:             } else {
                   2599:                 $result = &mt('Currently using local (institutional) authentication.');
                   2600:                 return $result;
1.165     raeburn  2601:             }
                   2602:         }
1.586     raeburn  2603:     } else {
                   2604:         if ($authnum == 1) {
1.784     bisitz   2605:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2606:         }
                   2607:     }
                   2608:     if (!$can_assign{'loc'}) {
                   2609:         return;
1.587     raeburn  2610:     } elsif ($authtype eq '') {
1.591     raeburn  2611:         if (defined($in{'mode'})) {
1.587     raeburn  2612:             if ($in{'mode'} eq 'modifycourse') {
                   2613:                 if ($authnum == 1) {
1.784     bisitz   2614:                     $authtype = '<input type="hidden" name="login" value="loc" />';
1.587     raeburn  2615:                 }
                   2616:             }
                   2617:         }
1.165     raeburn  2618:     }
1.586     raeburn  2619:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2620:     if ($authtype eq '') {
                   2621:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2622:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2623:                     $jscall.'" />';
                   2624:     }
                   2625:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2626:                $locarg.'" onchange="'.$jscall.'" />';
                   2627:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2628:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2629:     return $result;
                   2630: }
                   2631: 
                   2632: sub authform_filesystem{  
                   2633:     my %in = (
                   2634:               formname => 'document.cu',
                   2635:               kerb_def_dom => 'MSU.EDU',
                   2636:               @_,
                   2637:               );
1.586     raeburn  2638:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
                   2639:     my ($authnum,%can_assign) =  &get_assignable_auth($in{'domain'});
1.591     raeburn  2640:     if (defined($in{'curr_authtype'})) {
                   2641:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2642:             if ($can_assign{'fsys'}) {
1.772     bisitz   2643:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2644:                 if (defined($in{'mode'})) {
                   2645:                     if ($in{'mode'} eq 'modifyuser') {
                   2646:                         $fsyscheck = '';
                   2647:                     }
                   2648:                 }
1.586     raeburn  2649:             } else {
                   2650:                 $result = &mt('Currently Filesystem Authenticated.');
                   2651:                 return $result;
                   2652:             }           
                   2653:         }
                   2654:     } else {
                   2655:         if ($authnum == 1) {
1.784     bisitz   2656:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2657:         }
                   2658:     }
                   2659:     if (!$can_assign{'fsys'}) {
                   2660:         return;
1.587     raeburn  2661:     } elsif ($authtype eq '') {
1.591     raeburn  2662:         if (defined($in{'mode'})) {
1.587     raeburn  2663:             if ($in{'mode'} eq 'modifycourse') {
                   2664:                 if ($authnum == 1) {
1.784     bisitz   2665:                     $authtype = '<input type="hidden" name="login" value="fsys" />';
1.587     raeburn  2666:                 }
                   2667:             }
                   2668:         }
1.586     raeburn  2669:     }
                   2670:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2671:     if ($authtype eq '') {
                   2672:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2673:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2674:                     $jscall.'" />';
                   2675:     }
                   2676:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2677:                ' onchange="'.$jscall.'" />';
                   2678:     $result = &mt
1.144     matthew  2679:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2680:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2681:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2682:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2683:                   'onchange="'.$jscall.'" />');
1.32      matthew  2684:     return $result;
                   2685: }
                   2686: 
1.586     raeburn  2687: sub get_assignable_auth {
                   2688:     my ($dom) = @_;
                   2689:     if ($dom eq '') {
                   2690:         $dom = $env{'request.role.domain'};
                   2691:     }
                   2692:     my %can_assign = (
                   2693:                           krb4 => 1,
                   2694:                           krb5 => 1,
                   2695:                           int  => 1,
                   2696:                           loc  => 1,
                   2697:                      );
                   2698:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2699:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2700:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2701:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2702:             my $context;
                   2703:             if ($env{'request.role'} =~ /^au/) {
                   2704:                 $context = 'author';
                   2705:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2706:                 $context = 'domain';
                   2707:             } elsif ($env{'request.course.id'}) {
                   2708:                 $context = 'course';
                   2709:             }
                   2710:             if ($context) {
                   2711:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2712:                    %can_assign = %{$authhash->{$context}}; 
                   2713:                 }
                   2714:             }
                   2715:         }
                   2716:     }
                   2717:     my $authnum = 0;
                   2718:     foreach my $key (keys(%can_assign)) {
                   2719:         if ($can_assign{$key}) {
                   2720:             $authnum ++;
                   2721:         }
                   2722:     }
                   2723:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2724:         $authnum --;
                   2725:     }
                   2726:     return ($authnum,%can_assign);
                   2727: }
                   2728: 
1.80      albertel 2729: ###############################################################
                   2730: ##    Get Kerberos Defaults for Domain                 ##
                   2731: ###############################################################
                   2732: ##
                   2733: ## Returns default kerberos version and an associated argument
                   2734: ## as listed in file domain.tab. If not listed, provides
                   2735: ## appropriate default domain and kerberos version.
                   2736: ##
                   2737: #-------------------------------------------
                   2738: 
                   2739: =pod
                   2740: 
1.648     raeburn  2741: =item * &get_kerberos_defaults()
1.80      albertel 2742: 
                   2743: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2744: version and domain. If not found, it defaults to version 4 and the 
                   2745: domain of the server.
1.80      albertel 2746: 
1.648     raeburn  2747: =over 4
                   2748: 
1.80      albertel 2749: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2750: 
1.648     raeburn  2751: =back
                   2752: 
                   2753: =back
                   2754: 
1.80      albertel 2755: =cut
                   2756: 
                   2757: #-------------------------------------------
                   2758: sub get_kerberos_defaults {
                   2759:     my $domain=shift;
1.641     raeburn  2760:     my ($krbdef,$krbdefdom);
                   2761:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2762:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2763:         $krbdef = $domdefaults{'auth_def'};
                   2764:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2765:     } else {
1.80      albertel 2766:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2767:         my $krbdefdom=$1;
                   2768:         $krbdefdom=~tr/a-z/A-Z/;
                   2769:         $krbdef = "krb4";
                   2770:     }
                   2771:     return ($krbdef,$krbdefdom);
                   2772: }
1.112     bowersj2 2773: 
1.32      matthew  2774: 
1.46      matthew  2775: ###############################################################
                   2776: ##                Thesaurus Functions                        ##
                   2777: ###############################################################
1.20      www      2778: 
1.46      matthew  2779: =pod
1.20      www      2780: 
1.112     bowersj2 2781: =head1 Thesaurus Functions
                   2782: 
                   2783: =over 4
                   2784: 
1.648     raeburn  2785: =item * &initialize_keywords()
1.46      matthew  2786: 
                   2787: Initializes the package variable %Keywords if it is empty.  Uses the
                   2788: package variable $thesaurus_db_file.
                   2789: 
                   2790: =cut
                   2791: 
                   2792: ###################################################
                   2793: 
                   2794: sub initialize_keywords {
                   2795:     return 1 if (scalar keys(%Keywords));
                   2796:     # If we are here, %Keywords is empty, so fill it up
                   2797:     #   Make sure the file we need exists...
                   2798:     if (! -e $thesaurus_db_file) {
                   2799:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2800:                                  " failed because it does not exist");
                   2801:         return 0;
                   2802:     }
                   2803:     #   Set up the hash as a database
                   2804:     my %thesaurus_db;
                   2805:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2806:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2807:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2808:                                  $thesaurus_db_file);
                   2809:         return 0;
                   2810:     } 
                   2811:     #  Get the average number of appearances of a word.
                   2812:     my $avecount = $thesaurus_db{'average.count'};
                   2813:     #  Put keywords (those that appear > average) into %Keywords
                   2814:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2815:         my ($count,undef) = split /:/,$data;
                   2816:         $Keywords{$word}++ if ($count > $avecount);
                   2817:     }
                   2818:     untie %thesaurus_db;
                   2819:     # Remove special values from %Keywords.
1.356     albertel 2820:     foreach my $value ('total.count','average.count') {
                   2821:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2822:   }
1.46      matthew  2823:     return 1;
                   2824: }
                   2825: 
                   2826: ###################################################
                   2827: 
                   2828: =pod
                   2829: 
1.648     raeburn  2830: =item * &keyword($word)
1.46      matthew  2831: 
                   2832: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2833: than the average number of times in the thesaurus database.  Calls 
                   2834: &initialize_keywords
                   2835: 
                   2836: =cut
                   2837: 
                   2838: ###################################################
1.20      www      2839: 
                   2840: sub keyword {
1.46      matthew  2841:     return if (!&initialize_keywords());
                   2842:     my $word=lc(shift());
                   2843:     $word=~s/\W//g;
                   2844:     return exists($Keywords{$word});
1.20      www      2845: }
1.46      matthew  2846: 
                   2847: ###############################################################
                   2848: 
                   2849: =pod 
1.20      www      2850: 
1.648     raeburn  2851: =item * &get_related_words()
1.46      matthew  2852: 
1.160     matthew  2853: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  2854: an array of words.  If the keyword is not in the thesaurus, an empty array
                   2855: will be returned.  The order of the words returned is determined by the
                   2856: database which holds them.
                   2857: 
                   2858: Uses global $thesaurus_db_file.
                   2859: 
1.1057    foxr     2860: 
1.46      matthew  2861: =cut
                   2862: 
                   2863: ###############################################################
                   2864: sub get_related_words {
                   2865:     my $keyword = shift;
                   2866:     my %thesaurus_db;
                   2867:     if (! -e $thesaurus_db_file) {
                   2868:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   2869:                                  "failed because the file does not exist");
                   2870:         return ();
                   2871:     }
                   2872:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2873:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2874:         return ();
                   2875:     } 
                   2876:     my @Words=();
1.429     www      2877:     my $count=0;
1.46      matthew  2878:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 2879: 	# The first element is the number of times
                   2880: 	# the word appears.  We do not need it now.
1.429     www      2881: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   2882: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   2883: 	my $threshold=$mostfrequentcount/10;
                   2884:         foreach my $possibleword (@RelatedWords) {
                   2885:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   2886:             if ($wordcount>$threshold) {
                   2887: 		push(@Words,$word);
                   2888:                 $count++;
                   2889:                 if ($count>10) { last; }
                   2890: 	    }
1.20      www      2891:         }
                   2892:     }
1.46      matthew  2893:     untie %thesaurus_db;
                   2894:     return @Words;
1.14      harris41 2895: }
1.46      matthew  2896: 
1.112     bowersj2 2897: =pod
                   2898: 
                   2899: =back
                   2900: 
                   2901: =cut
1.61      www      2902: 
                   2903: # -------------------------------------------------------------- Plaintext name
1.81      albertel 2904: =pod
                   2905: 
1.112     bowersj2 2906: =head1 User Name Functions
                   2907: 
                   2908: =over 4
                   2909: 
1.648     raeburn  2910: =item * &plainname($uname,$udom,$first)
1.81      albertel 2911: 
1.112     bowersj2 2912: Takes a users logon name and returns it as a string in
1.226     albertel 2913: "first middle last generation" form 
                   2914: if $first is set to 'lastname' then it returns it as
                   2915: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 2916: 
                   2917: =cut
1.61      www      2918: 
1.295     www      2919: 
1.81      albertel 2920: ###############################################################
1.61      www      2921: sub plainname {
1.226     albertel 2922:     my ($uname,$udom,$first)=@_;
1.537     albertel 2923:     return if (!defined($uname) || !defined($udom));
1.295     www      2924:     my %names=&getnames($uname,$udom);
1.226     albertel 2925:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   2926: 					  $names{'middlename'},
                   2927: 					  $names{'lastname'},
                   2928: 					  $names{'generation'},$first);
                   2929:     $name=~s/^\s+//;
1.62      www      2930:     $name=~s/\s+$//;
                   2931:     $name=~s/\s+/ /g;
1.353     albertel 2932:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      2933:     return $name;
1.61      www      2934: }
1.66      www      2935: 
                   2936: # -------------------------------------------------------------------- Nickname
1.81      albertel 2937: =pod
                   2938: 
1.648     raeburn  2939: =item * &nickname($uname,$udom)
1.81      albertel 2940: 
                   2941: Gets a users name and returns it as a string as
                   2942: 
                   2943: "&quot;nickname&quot;"
1.66      www      2944: 
1.81      albertel 2945: if the user has a nickname or
                   2946: 
                   2947: "first middle last generation"
                   2948: 
                   2949: if the user does not
                   2950: 
                   2951: =cut
1.66      www      2952: 
                   2953: sub nickname {
                   2954:     my ($uname,$udom)=@_;
1.537     albertel 2955:     return if (!defined($uname) || !defined($udom));
1.295     www      2956:     my %names=&getnames($uname,$udom);
1.68      albertel 2957:     my $name=$names{'nickname'};
1.66      www      2958:     if ($name) {
                   2959:        $name='&quot;'.$name.'&quot;'; 
                   2960:     } else {
                   2961:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   2962: 	     $names{'lastname'}.' '.$names{'generation'};
                   2963:        $name=~s/\s+$//;
                   2964:        $name=~s/\s+/ /g;
                   2965:     }
                   2966:     return $name;
                   2967: }
                   2968: 
1.295     www      2969: sub getnames {
                   2970:     my ($uname,$udom)=@_;
1.537     albertel 2971:     return if (!defined($uname) || !defined($udom));
1.433     albertel 2972:     if ($udom eq 'public' && $uname eq 'public') {
                   2973: 	return ('lastname' => &mt('Public'));
                   2974:     }
1.295     www      2975:     my $id=$uname.':'.$udom;
                   2976:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   2977:     if ($cached) {
                   2978: 	return %{$names};
                   2979:     } else {
                   2980: 	my %loadnames=&Apache::lonnet::get('environment',
                   2981:                     ['firstname','middlename','lastname','generation','nickname'],
                   2982: 					 $udom,$uname);
                   2983: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   2984: 	return %loadnames;
                   2985:     }
                   2986: }
1.61      www      2987: 
1.542     raeburn  2988: # -------------------------------------------------------------------- getemails
1.648     raeburn  2989: 
1.542     raeburn  2990: =pod
                   2991: 
1.648     raeburn  2992: =item * &getemails($uname,$udom)
1.542     raeburn  2993: 
                   2994: Gets a user's email information and returns it as a hash with keys:
                   2995: notification, critnotification, permanentemail
                   2996: 
                   2997: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  2998: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  2999:  
1.648     raeburn  3000: 
1.542     raeburn  3001: =cut
                   3002: 
1.648     raeburn  3003: 
1.466     albertel 3004: sub getemails {
                   3005:     my ($uname,$udom)=@_;
                   3006:     if ($udom eq 'public' && $uname eq 'public') {
                   3007: 	return;
                   3008:     }
1.467     www      3009:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3010:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3011:     my $id=$uname.':'.$udom;
                   3012:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3013:     if ($cached) {
                   3014: 	return %{$names};
                   3015:     } else {
                   3016: 	my %loadnames=&Apache::lonnet::get('environment',
                   3017:                     			   ['notification','critnotification',
                   3018: 					    'permanentemail'],
                   3019: 					   $udom,$uname);
                   3020: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3021: 	return %loadnames;
                   3022:     }
                   3023: }
                   3024: 
1.551     albertel 3025: sub flush_email_cache {
                   3026:     my ($uname,$udom)=@_;
                   3027:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3028:     if (!$uname) { $uname=$env{'user.name'};   }
                   3029:     return if ($udom eq 'public' && $uname eq 'public');
                   3030:     my $id=$uname.':'.$udom;
                   3031:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3032: }
                   3033: 
1.728     raeburn  3034: # -------------------------------------------------------------------- getlangs
                   3035: 
                   3036: =pod
                   3037: 
                   3038: =item * &getlangs($uname,$udom)
                   3039: 
                   3040: Gets a user's language preference and returns it as a hash with key:
                   3041: language.
                   3042: 
                   3043: =cut
                   3044: 
                   3045: 
                   3046: sub getlangs {
                   3047:     my ($uname,$udom) = @_;
                   3048:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3049:     if (!$uname) { $uname=$env{'user.name'};   }
                   3050:     my $id=$uname.':'.$udom;
                   3051:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3052:     if ($cached) {
                   3053:         return %{$langs};
                   3054:     } else {
                   3055:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3056:                                            $udom,$uname);
                   3057:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3058:         return %loadlangs;
                   3059:     }
                   3060: }
                   3061: 
                   3062: sub flush_langs_cache {
                   3063:     my ($uname,$udom)=@_;
                   3064:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3065:     if (!$uname) { $uname=$env{'user.name'};   }
                   3066:     return if ($udom eq 'public' && $uname eq 'public');
                   3067:     my $id=$uname.':'.$udom;
                   3068:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3069: }
                   3070: 
1.61      www      3071: # ------------------------------------------------------------------ Screenname
1.81      albertel 3072: 
                   3073: =pod
                   3074: 
1.648     raeburn  3075: =item * &screenname($uname,$udom)
1.81      albertel 3076: 
                   3077: Gets a users screenname and returns it as a string
                   3078: 
                   3079: =cut
1.61      www      3080: 
                   3081: sub screenname {
                   3082:     my ($uname,$udom)=@_;
1.258     albertel 3083:     if ($uname eq $env{'user.name'} &&
                   3084: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3085:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3086:     return $names{'screenname'};
1.62      www      3087: }
                   3088: 
1.212     albertel 3089: 
1.802     bisitz   3090: # ------------------------------------------------------------- Confirm Wrapper
                   3091: =pod
                   3092: 
                   3093: =item confirmwrapper
                   3094: 
                   3095: Wrap messages about completion of operation in box
                   3096: 
                   3097: =cut
                   3098: 
                   3099: sub confirmwrapper {
                   3100:     my ($message)=@_;
                   3101:     if ($message) {
                   3102:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3103:                .$message."\n"
                   3104:                .'</div>'."\n";
                   3105:     } else {
                   3106:         return $message;
                   3107:     }
                   3108: }
                   3109: 
1.62      www      3110: # ------------------------------------------------------------- Message Wrapper
                   3111: 
                   3112: sub messagewrapper {
1.369     www      3113:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3114:     return 
1.441     albertel 3115:         '<a href="/adm/email?compose=individual&amp;'.
                   3116:         'recname='.$username.'&amp;recdom='.$domain.
                   3117: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3118:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3119: }
1.802     bisitz   3120: 
1.74      www      3121: # --------------------------------------------------------------- Notes Wrapper
                   3122: 
                   3123: sub noteswrapper {
                   3124:     my ($link,$un,$do)=@_;
                   3125:     return 
1.896     amueller 3126: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3127: }
1.802     bisitz   3128: 
1.62      www      3129: # ------------------------------------------------------------- Aboutme Wrapper
                   3130: 
                   3131: sub aboutmewrapper {
1.1070    raeburn  3132:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3133:     if (!defined($username)  && !defined($domain)) {
                   3134:         return;
                   3135:     }
1.892     amueller 3136:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme?forcestudent=1"'.
1.1070    raeburn  3137: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3138: }
                   3139: 
                   3140: # ------------------------------------------------------------ Syllabus Wrapper
                   3141: 
                   3142: sub syllabuswrapper {
1.707     bisitz   3143:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3144:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3145: }
1.14      harris41 3146: 
1.802     bisitz   3147: # -----------------------------------------------------------------------------
                   3148: 
1.208     matthew  3149: sub track_student_link {
1.887     raeburn  3150:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3151:     my $link ="/adm/trackstudent?";
1.208     matthew  3152:     my $title = 'View recent activity';
                   3153:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3154:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3155:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3156:         $title .= ' of this student';
1.268     albertel 3157:     } 
1.208     matthew  3158:     if (defined($target) && $target !~ /^\s*$/) {
                   3159:         $target = qq{target="$target"};
                   3160:     } else {
                   3161:         $target = '';
                   3162:     }
1.268     albertel 3163:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3164:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3165:     $title = &mt($title);
                   3166:     $linktext = &mt($linktext);
1.448     albertel 3167:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3168: 	&help_open_topic('View_recent_activity');
1.208     matthew  3169: }
                   3170: 
1.781     raeburn  3171: sub slot_reservations_link {
                   3172:     my ($linktext,$sname,$sdom,$target) = @_;
                   3173:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3174:     my $title = 'View slot reservation history';
                   3175:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3176:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3177:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3178:         $title .= ' of this student';
                   3179:     }
                   3180:     if (defined($target) && $target !~ /^\s*$/) {
                   3181:         $target = qq{target="$target"};
                   3182:     } else {
                   3183:         $target = '';
                   3184:     }
                   3185:     $title = &mt($title);
                   3186:     $linktext = &mt($linktext);
                   3187:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3188: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3189: 
                   3190: }
                   3191: 
1.508     www      3192: # ===================================================== Display a student photo
                   3193: 
                   3194: 
1.509     albertel 3195: sub student_image_tag {
1.508     www      3196:     my ($domain,$user)=@_;
                   3197:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3198:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3199: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3200:     } else {
                   3201: 	return '';
                   3202:     }
                   3203: }
                   3204: 
1.112     bowersj2 3205: =pod
                   3206: 
                   3207: =back
                   3208: 
                   3209: =head1 Access .tab File Data
                   3210: 
                   3211: =over 4
                   3212: 
1.648     raeburn  3213: =item * &languageids() 
1.112     bowersj2 3214: 
                   3215: returns list of all language ids
                   3216: 
                   3217: =cut
                   3218: 
1.14      harris41 3219: sub languageids {
1.16      harris41 3220:     return sort(keys(%language));
1.14      harris41 3221: }
                   3222: 
1.112     bowersj2 3223: =pod
                   3224: 
1.648     raeburn  3225: =item * &languagedescription() 
1.112     bowersj2 3226: 
                   3227: returns description of a specified language id
                   3228: 
                   3229: =cut
                   3230: 
1.14      harris41 3231: sub languagedescription {
1.125     www      3232:     my $code=shift;
                   3233:     return  ($supported_language{$code}?'* ':'').
                   3234:             $language{$code}.
1.126     www      3235: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3236: }
                   3237: 
1.1048    foxr     3238: =pod
                   3239: 
                   3240: =item * &plainlanguagedescription
                   3241: 
                   3242: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3243: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3244: 
                   3245: =cut
                   3246: 
1.145     www      3247: sub plainlanguagedescription {
                   3248:     my $code=shift;
                   3249:     return $language{$code};
                   3250: }
                   3251: 
1.1048    foxr     3252: =pod
                   3253: 
                   3254: =item * &supportedlanguagecode
                   3255: 
                   3256: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3257: code.
                   3258: 
                   3259: =cut
                   3260: 
1.145     www      3261: sub supportedlanguagecode {
                   3262:     my $code=shift;
                   3263:     return $supported_language{$code};
1.97      www      3264: }
                   3265: 
1.112     bowersj2 3266: =pod
                   3267: 
1.1048    foxr     3268: =item * &latexlanguage()
                   3269: 
                   3270: Given a language key code returns the correspondnig language to use
                   3271: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3272: is no supported hyphenation for the language code.
                   3273: 
                   3274: =cut
                   3275: 
                   3276: sub latexlanguage {
                   3277:     my $code = shift;
                   3278:     return $latex_language{$code};
                   3279: }
                   3280: 
                   3281: =pod
                   3282: 
                   3283: =item * &latexhyphenation()
                   3284: 
                   3285: Same as above but what's supplied is the language as it might be stored
                   3286: in the metadata.
                   3287: 
                   3288: =cut
                   3289: 
                   3290: sub latexhyphenation {
                   3291:     my $key = shift;
                   3292:     return $latex_language_bykey{$key};
                   3293: }
                   3294: 
                   3295: =pod
                   3296: 
1.648     raeburn  3297: =item * &copyrightids() 
1.112     bowersj2 3298: 
                   3299: returns list of all copyrights
                   3300: 
                   3301: =cut
                   3302: 
                   3303: sub copyrightids {
                   3304:     return sort(keys(%cprtag));
                   3305: }
                   3306: 
                   3307: =pod
                   3308: 
1.648     raeburn  3309: =item * &copyrightdescription() 
1.112     bowersj2 3310: 
                   3311: returns description of a specified copyright id
                   3312: 
                   3313: =cut
                   3314: 
                   3315: sub copyrightdescription {
1.166     www      3316:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3317: }
1.197     matthew  3318: 
                   3319: =pod
                   3320: 
1.648     raeburn  3321: =item * &source_copyrightids() 
1.192     taceyjo1 3322: 
                   3323: returns list of all source copyrights
                   3324: 
                   3325: =cut
                   3326: 
                   3327: sub source_copyrightids {
                   3328:     return sort(keys(%scprtag));
                   3329: }
                   3330: 
                   3331: =pod
                   3332: 
1.648     raeburn  3333: =item * &source_copyrightdescription() 
1.192     taceyjo1 3334: 
                   3335: returns description of a specified source copyright id
                   3336: 
                   3337: =cut
                   3338: 
                   3339: sub source_copyrightdescription {
                   3340:     return &mt($scprtag{shift(@_)});
                   3341: }
1.112     bowersj2 3342: 
                   3343: =pod
                   3344: 
1.648     raeburn  3345: =item * &filecategories() 
1.112     bowersj2 3346: 
                   3347: returns list of all file categories
                   3348: 
                   3349: =cut
                   3350: 
                   3351: sub filecategories {
                   3352:     return sort(keys(%category_extensions));
                   3353: }
                   3354: 
                   3355: =pod
                   3356: 
1.648     raeburn  3357: =item * &filecategorytypes() 
1.112     bowersj2 3358: 
                   3359: returns list of file types belonging to a given file
                   3360: category
                   3361: 
                   3362: =cut
                   3363: 
                   3364: sub filecategorytypes {
1.356     albertel 3365:     my ($cat) = @_;
                   3366:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3367: }
                   3368: 
                   3369: =pod
                   3370: 
1.648     raeburn  3371: =item * &fileembstyle() 
1.112     bowersj2 3372: 
                   3373: returns embedding style for a specified file type
                   3374: 
                   3375: =cut
                   3376: 
                   3377: sub fileembstyle {
                   3378:     return $fe{lc(shift(@_))};
1.169     www      3379: }
                   3380: 
1.351     www      3381: sub filemimetype {
                   3382:     return $fm{lc(shift(@_))};
                   3383: }
                   3384: 
1.169     www      3385: 
                   3386: sub filecategoryselect {
                   3387:     my ($name,$value)=@_;
1.189     matthew  3388:     return &select_form($value,$name,
1.970     raeburn  3389:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3390: }
                   3391: 
                   3392: =pod
                   3393: 
1.648     raeburn  3394: =item * &filedescription() 
1.112     bowersj2 3395: 
                   3396: returns description for a specified file type
                   3397: 
                   3398: =cut
                   3399: 
                   3400: sub filedescription {
1.188     matthew  3401:     my $file_description = $fd{lc(shift())};
                   3402:     $file_description =~ s:([\[\]]):~$1:g;
                   3403:     return &mt($file_description);
1.112     bowersj2 3404: }
                   3405: 
                   3406: =pod
                   3407: 
1.648     raeburn  3408: =item * &filedescriptionex() 
1.112     bowersj2 3409: 
                   3410: returns description for a specified file type with
                   3411: extra formatting
                   3412: 
                   3413: =cut
                   3414: 
                   3415: sub filedescriptionex {
                   3416:     my $ex=shift;
1.188     matthew  3417:     my $file_description = $fd{lc($ex)};
                   3418:     $file_description =~ s:([\[\]]):~$1:g;
                   3419:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3420: }
                   3421: 
                   3422: # End of .tab access
                   3423: =pod
                   3424: 
                   3425: =back
                   3426: 
                   3427: =cut
                   3428: 
                   3429: # ------------------------------------------------------------------ File Types
                   3430: sub fileextensions {
                   3431:     return sort(keys(%fe));
                   3432: }
                   3433: 
1.97      www      3434: # ----------------------------------------------------------- Display Languages
                   3435: # returns a hash with all desired display languages
                   3436: #
                   3437: 
                   3438: sub display_languages {
                   3439:     my %languages=();
1.695     raeburn  3440:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3441: 	$languages{$lang}=1;
1.97      www      3442:     }
                   3443:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3444:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3445: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3446: 	    $languages{$lang}=1;
1.97      www      3447:         }
                   3448:     }
                   3449:     return %languages;
1.14      harris41 3450: }
                   3451: 
1.582     albertel 3452: sub languages {
                   3453:     my ($possible_langs) = @_;
1.695     raeburn  3454:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3455:     if (!ref($possible_langs)) {
                   3456: 	if( wantarray ) {
                   3457: 	    return @preferred_langs;
                   3458: 	} else {
                   3459: 	    return $preferred_langs[0];
                   3460: 	}
                   3461:     }
                   3462:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3463:     my @preferred_possibilities;
                   3464:     foreach my $preferred_lang (@preferred_langs) {
                   3465: 	if (exists($possibilities{$preferred_lang})) {
                   3466: 	    push(@preferred_possibilities, $preferred_lang);
                   3467: 	}
                   3468:     }
                   3469:     if( wantarray ) {
                   3470: 	return @preferred_possibilities;
                   3471:     }
                   3472:     return $preferred_possibilities[0];
                   3473: }
                   3474: 
1.742     raeburn  3475: sub user_lang {
                   3476:     my ($touname,$toudom,$fromcid) = @_;
                   3477:     my @userlangs;
                   3478:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3479:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3480:                     $env{'course.'.$fromcid.'.languages'}));
                   3481:     } else {
                   3482:         my %langhash = &getlangs($touname,$toudom);
                   3483:         if ($langhash{'languages'} ne '') {
                   3484:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3485:         } else {
                   3486:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3487:             if ($domdefs{'lang_def'} ne '') {
                   3488:                 @userlangs = ($domdefs{'lang_def'});
                   3489:             }
                   3490:         }
                   3491:     }
                   3492:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3493:     my $user_lh = Apache::localize->get_handle(@languages);
                   3494:     return $user_lh;
                   3495: }
                   3496: 
                   3497: 
1.112     bowersj2 3498: ###############################################################
                   3499: ##               Student Answer Attempts                     ##
                   3500: ###############################################################
                   3501: 
                   3502: =pod
                   3503: 
                   3504: =head1 Alternate Problem Views
                   3505: 
                   3506: =over 4
                   3507: 
1.648     raeburn  3508: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3509:     $getattempt, $regexp, $gradesub)
                   3510: 
                   3511: Return string with previous attempt on problem. Arguments:
                   3512: 
                   3513: =over 4
                   3514: 
                   3515: =item * $symb: Problem, including path
                   3516: 
                   3517: =item * $username: username of the desired student
                   3518: 
                   3519: =item * $domain: domain of the desired student
1.14      harris41 3520: 
1.112     bowersj2 3521: =item * $course: Course ID
1.14      harris41 3522: 
1.112     bowersj2 3523: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3524:     something
1.14      harris41 3525: 
1.112     bowersj2 3526: =item * $regexp: if string matches this regexp, the string will be
                   3527:     sent to $gradesub
1.14      harris41 3528: 
1.112     bowersj2 3529: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3530: 
1.112     bowersj2 3531: =back
1.14      harris41 3532: 
1.112     bowersj2 3533: The output string is a table containing all desired attempts, if any.
1.16      harris41 3534: 
1.112     bowersj2 3535: =cut
1.1       albertel 3536: 
                   3537: sub get_previous_attempt {
1.43      ng       3538:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3539:   my $prevattempts='';
1.43      ng       3540:   no strict 'refs';
1.1       albertel 3541:   if ($symb) {
1.3       albertel 3542:     my (%returnhash)=
                   3543:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3544:     if ($returnhash{'version'}) {
                   3545:       my %lasthash=();
                   3546:       my $version;
                   3547:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3548:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3549: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3550:         }
1.1       albertel 3551:       }
1.596     albertel 3552:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3553:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3554:       my (%typeparts,%lasthidden);
1.945     raeburn  3555:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3556:       foreach my $key (sort(keys(%lasthash))) {
                   3557: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3558: 	if ($#parts > 0) {
1.31      albertel 3559: 	  my $data=$parts[-1];
1.989     raeburn  3560:           next if ($data eq 'foilorder');
1.31      albertel 3561: 	  pop(@parts);
1.1010    www      3562:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3563:           if ($data eq 'type') {
                   3564:               unless ($showsurv) {
                   3565:                   my $id = join(',',@parts);
                   3566:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3567:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3568:                       $lasthidden{$ign.'.'.$id} = 1;
                   3569:                   }
1.945     raeburn  3570:               }
1.1010    www      3571:           } 
1.31      albertel 3572: 	} else {
1.41      ng       3573: 	  if ($#parts == 0) {
                   3574: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3575: 	  } else {
                   3576: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3577: 	  }
1.31      albertel 3578: 	}
1.16      harris41 3579:       }
1.596     albertel 3580:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3581:       if ($getattempt eq '') {
                   3582: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3583:             my @hidden;
                   3584:             if (%typeparts) {
                   3585:                 foreach my $id (keys(%typeparts)) {
                   3586:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3587:                         push(@hidden,$id);
                   3588:                     }
                   3589:                 }
                   3590:             }
                   3591:             $prevattempts.=&start_data_table_row().
                   3592:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3593:             if (@hidden) {
                   3594:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3595:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3596:                     my $hide;
                   3597:                     foreach my $id (@hidden) {
                   3598:                         if ($key =~ /^\Q$id\E/) {
                   3599:                             $hide = 1;
                   3600:                             last;
                   3601:                         }
                   3602:                     }
                   3603:                     if ($hide) {
                   3604:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3605:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3606:                             my $value = &format_previous_attempt_value($key,
                   3607:                                              $returnhash{$version.':'.$key});
                   3608:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3609:                         } else {
                   3610:                             $prevattempts.='<td>&nbsp;</td>';
                   3611:                         }
                   3612:                     } else {
                   3613:                         if ($key =~ /\./) {
                   3614:                             my $value = &format_previous_attempt_value($key,
                   3615:                                               $returnhash{$version.':'.$key});
                   3616:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3617:                         } else {
                   3618:                             $prevattempts.='<td>&nbsp;</td>';
                   3619:                         }
                   3620:                     }
                   3621:                 }
                   3622:             } else {
                   3623: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3624:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3625: 		    my $value = &format_previous_attempt_value($key,
                   3626: 			            $returnhash{$version.':'.$key});
                   3627: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3628: 	        }
                   3629:             }
                   3630: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3631: 	 }
1.1       albertel 3632:       }
1.945     raeburn  3633:       my @currhidden = keys(%lasthidden);
1.596     albertel 3634:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3635:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3636:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3637:           if (%typeparts) {
                   3638:               my $hidden;
                   3639:               foreach my $id (@currhidden) {
                   3640:                   if ($key =~ /^\Q$id\E/) {
                   3641:                       $hidden = 1;
                   3642:                       last;
                   3643:                   }
                   3644:               }
                   3645:               if ($hidden) {
                   3646:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3647:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3648:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3649:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3650:                           $value = &$gradesub($value);
                   3651:                       }
                   3652:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3653:                   } else {
                   3654:                       $prevattempts.='<td>&nbsp;</td>';
                   3655:                   }
                   3656:               } else {
                   3657:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3658:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3659:                       $value = &$gradesub($value);
                   3660:                   }
                   3661:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3662:               }
                   3663:           } else {
                   3664: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3665: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3666:                   $value = &$gradesub($value);
                   3667:               }
                   3668: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3669:           }
1.16      harris41 3670:       }
1.596     albertel 3671:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3672:     } else {
1.596     albertel 3673:       $prevattempts=
                   3674: 	  &start_data_table().&start_data_table_row().
                   3675: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3676: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3677:     }
                   3678:   } else {
1.596     albertel 3679:     $prevattempts=
                   3680: 	  &start_data_table().&start_data_table_row().
                   3681: 	  '<td>'.&mt('No data.').'</td>'.
                   3682: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3683:   }
1.10      albertel 3684: }
                   3685: 
1.581     albertel 3686: sub format_previous_attempt_value {
                   3687:     my ($key,$value) = @_;
1.1011    www      3688:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3689: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3690:     } elsif (ref($value) eq 'ARRAY') {
                   3691: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3692:     } elsif ($key =~ /answerstring$/) {
                   3693:         my %answers = &Apache::lonnet::str2hash($value);
                   3694:         my @anskeys = sort(keys(%answers));
                   3695:         if (@anskeys == 1) {
                   3696:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3697:             if ($answer =~ m{\0}) {
                   3698:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3699:             }
                   3700:             my $tag_internal_answer_name = 'INTERNAL';
                   3701:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3702:                 $value = $answer; 
                   3703:             } else {
                   3704:                 $value = $anskeys[0].'='.$answer;
                   3705:             }
                   3706:         } else {
                   3707:             foreach my $ans (@anskeys) {
                   3708:                 my $answer = $answers{$ans};
1.1001    raeburn  3709:                 if ($answer =~ m{\0}) {
                   3710:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3711:                 }
                   3712:                 $value .=  $ans.'='.$answer.'<br />';;
                   3713:             } 
                   3714:         }
1.581     albertel 3715:     } else {
                   3716: 	$value = &unescape($value);
                   3717:     }
                   3718:     return $value;
                   3719: }
                   3720: 
                   3721: 
1.107     albertel 3722: sub relative_to_absolute {
                   3723:     my ($url,$output)=@_;
                   3724:     my $parser=HTML::TokeParser->new(\$output);
                   3725:     my $token;
                   3726:     my $thisdir=$url;
                   3727:     my @rlinks=();
                   3728:     while ($token=$parser->get_token) {
                   3729: 	if ($token->[0] eq 'S') {
                   3730: 	    if ($token->[1] eq 'a') {
                   3731: 		if ($token->[2]->{'href'}) {
                   3732: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3733: 		}
                   3734: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3735: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3736: 	    } elsif ($token->[1] eq 'base') {
                   3737: 		$thisdir=$token->[2]->{'href'};
                   3738: 	    }
                   3739: 	}
                   3740:     }
                   3741:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3742:     foreach my $link (@rlinks) {
1.726     raeburn  3743: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3744: 		($link=~/^\//) ||
                   3745: 		($link=~/^javascript:/i) ||
                   3746: 		($link=~/^mailto:/i) ||
                   3747: 		($link=~/^\#/)) {
                   3748: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3749: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3750: 	}
                   3751:     }
                   3752: # -------------------------------------------------- Deal with Applet codebases
                   3753:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3754:     return $output;
                   3755: }
                   3756: 
1.112     bowersj2 3757: =pod
                   3758: 
1.648     raeburn  3759: =item * &get_student_view()
1.112     bowersj2 3760: 
                   3761: show a snapshot of what student was looking at
                   3762: 
                   3763: =cut
                   3764: 
1.10      albertel 3765: sub get_student_view {
1.186     albertel 3766:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3767:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3768:   my (%form);
1.10      albertel 3769:   my @elements=('symb','courseid','domain','username');
                   3770:   foreach my $element (@elements) {
1.186     albertel 3771:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3772:   }
1.186     albertel 3773:   if (defined($moreenv)) {
                   3774:       %form=(%form,%{$moreenv});
                   3775:   }
1.236     albertel 3776:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3777:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3778:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3779:   $userview=~s/\<body[^\>]*\>//gi;
                   3780:   $userview=~s/\<\/body\>//gi;
                   3781:   $userview=~s/\<html\>//gi;
                   3782:   $userview=~s/\<\/html\>//gi;
                   3783:   $userview=~s/\<head\>//gi;
                   3784:   $userview=~s/\<\/head\>//gi;
                   3785:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3786:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3787:   if (wantarray) {
                   3788:      return ($userview,$response);
                   3789:   } else {
                   3790:      return $userview;
                   3791:   }
                   3792: }
                   3793: 
                   3794: sub get_student_view_with_retries {
                   3795:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3796: 
                   3797:     my $ok = 0;                 # True if we got a good response.
                   3798:     my $content;
                   3799:     my $response;
                   3800: 
                   3801:     # Try to get the student_view done. within the retries count:
                   3802:     
                   3803:     do {
                   3804:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3805:          $ok      = $response->is_success;
                   3806:          if (!$ok) {
                   3807:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3808:          }
                   3809:          $retries--;
                   3810:     } while (!$ok && ($retries > 0));
                   3811:     
                   3812:     if (!$ok) {
                   3813:        $content = '';          # On error return an empty content.
                   3814:     }
1.651     www      3815:     if (wantarray) {
                   3816:        return ($content, $response);
                   3817:     } else {
                   3818:        return $content;
                   3819:     }
1.11      albertel 3820: }
                   3821: 
1.112     bowersj2 3822: =pod
                   3823: 
1.648     raeburn  3824: =item * &get_student_answers() 
1.112     bowersj2 3825: 
                   3826: show a snapshot of how student was answering problem
                   3827: 
                   3828: =cut
                   3829: 
1.11      albertel 3830: sub get_student_answers {
1.100     sakharuk 3831:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3832:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3833:   my (%moreenv);
1.11      albertel 3834:   my @elements=('symb','courseid','domain','username');
                   3835:   foreach my $element (@elements) {
1.186     albertel 3836:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3837:   }
1.186     albertel 3838:   $moreenv{'grade_target'}='answer';
                   3839:   %moreenv=(%form,%moreenv);
1.497     raeburn  3840:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   3841:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 3842:   return $userview;
1.1       albertel 3843: }
1.116     albertel 3844: 
                   3845: =pod
                   3846: 
                   3847: =item * &submlink()
                   3848: 
1.242     albertel 3849: Inputs: $text $uname $udom $symb $target
1.116     albertel 3850: 
                   3851: Returns: A link to grades.pm such as to see the SUBM view of a student
                   3852: 
                   3853: =cut
                   3854: 
                   3855: ###############################################
                   3856: sub submlink {
1.242     albertel 3857:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 3858:     if (!($uname && $udom)) {
                   3859: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3860: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 3861: 	if (!$symb) { $symb=$cursymb; }
                   3862:     }
1.254     matthew  3863:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3864:     $symb=&escape($symb);
1.960     bisitz   3865:     if ($target) { $target=" target=\"$target\""; }
                   3866:     return
                   3867:         '<a href="/adm/grades?command=submission'.
                   3868:         '&amp;symb='.$symb.
                   3869:         '&amp;student='.$uname.
                   3870:         '&amp;userdom='.$udom.'"'.
                   3871:         $target.'>'.$text.'</a>';
1.242     albertel 3872: }
                   3873: ##############################################
                   3874: 
                   3875: =pod
                   3876: 
                   3877: =item * &pgrdlink()
                   3878: 
                   3879: Inputs: $text $uname $udom $symb $target
                   3880: 
                   3881: Returns: A link to grades.pm such as to see the PGRD view of a student
                   3882: 
                   3883: =cut
                   3884: 
                   3885: ###############################################
                   3886: sub pgrdlink {
                   3887:     my $link=&submlink(@_);
                   3888:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   3889:     return $link;
                   3890: }
                   3891: ##############################################
                   3892: 
                   3893: =pod
                   3894: 
                   3895: =item * &pprmlink()
                   3896: 
                   3897: Inputs: $text $uname $udom $symb $target
                   3898: 
                   3899: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 3900: student and a specific resource
1.242     albertel 3901: 
                   3902: =cut
                   3903: 
                   3904: ###############################################
                   3905: sub pprmlink {
                   3906:     my ($text,$uname,$udom,$symb,$target)=@_;
                   3907:     if (!($uname && $udom)) {
                   3908: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 3909: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 3910: 	if (!$symb) { $symb=$cursymb; }
                   3911:     }
1.254     matthew  3912:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      3913:     $symb=&escape($symb);
1.242     albertel 3914:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 3915:     return '<a href="/adm/parmset?command=set&amp;'.
                   3916: 	'symb='.$symb.'&amp;uname='.$uname.
                   3917: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 3918: }
                   3919: ##############################################
1.37      matthew  3920: 
1.112     bowersj2 3921: =pod
                   3922: 
                   3923: =back
                   3924: 
                   3925: =cut
                   3926: 
1.37      matthew  3927: ###############################################
1.51      www      3928: 
                   3929: 
                   3930: sub timehash {
1.687     raeburn  3931:     my ($thistime) = @_;
                   3932:     my $timezone = &Apache::lonlocal::gettimezone();
                   3933:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   3934:                      ->set_time_zone($timezone);
                   3935:     my $wday = $dt->day_of_week();
                   3936:     if ($wday == 7) { $wday = 0; }
                   3937:     return ( 'second' => $dt->second(),
                   3938:              'minute' => $dt->minute(),
                   3939:              'hour'   => $dt->hour(),
                   3940:              'day'     => $dt->day_of_month(),
                   3941:              'month'   => $dt->month(),
                   3942:              'year'    => $dt->year(),
                   3943:              'weekday' => $wday,
                   3944:              'dayyear' => $dt->day_of_year(),
                   3945:              'dlsav'   => $dt->is_dst() );
1.51      www      3946: }
                   3947: 
1.370     www      3948: sub utc_string {
                   3949:     my ($date)=@_;
1.371     www      3950:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      3951: }
                   3952: 
1.51      www      3953: sub maketime {
                   3954:     my %th=@_;
1.687     raeburn  3955:     my ($epoch_time,$timezone,$dt);
                   3956:     $timezone = &Apache::lonlocal::gettimezone();
                   3957:     eval {
                   3958:         $dt = DateTime->new( year   => $th{'year'},
                   3959:                              month  => $th{'month'},
                   3960:                              day    => $th{'day'},
                   3961:                              hour   => $th{'hour'},
                   3962:                              minute => $th{'minute'},
                   3963:                              second => $th{'second'},
                   3964:                              time_zone => $timezone,
                   3965:                          );
                   3966:     };
                   3967:     if (!$@) {
                   3968:         $epoch_time = $dt->epoch;
                   3969:         if ($epoch_time) {
                   3970:             return $epoch_time;
                   3971:         }
                   3972:     }
1.51      www      3973:     return POSIX::mktime(
                   3974:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      3975:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      3976: }
                   3977: 
                   3978: #########################################
1.51      www      3979: 
                   3980: sub findallcourses {
1.482     raeburn  3981:     my ($roles,$uname,$udom) = @_;
1.355     albertel 3982:     my %roles;
                   3983:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 3984:     my %courses;
1.51      www      3985:     my $now=time;
1.482     raeburn  3986:     if (!defined($uname)) {
                   3987:         $uname = $env{'user.name'};
                   3988:     }
                   3989:     if (!defined($udom)) {
                   3990:         $udom = $env{'user.domain'};
                   3991:     }
                   3992:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.982     raeburn  3993:         my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
                   3994:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,
                   3995:                                               $extra);
1.482     raeburn  3996:         if (!%roles) {
                   3997:             %roles = (
                   3998:                        cc => 1,
1.907     raeburn  3999:                        co => 1,
1.482     raeburn  4000:                        in => 1,
                   4001:                        ep => 1,
                   4002:                        ta => 1,
                   4003:                        cr => 1,
                   4004:                        st => 1,
                   4005:              );
                   4006:         }
                   4007:         foreach my $entry (keys(%roleshash)) {
                   4008:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4009:             if ($trole =~ /^cr/) { 
                   4010:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4011:             } else {
                   4012:                 next if (!exists($roles{$trole}));
                   4013:             }
                   4014:             if ($tend) {
                   4015:                 next if ($tend < $now);
                   4016:             }
                   4017:             if ($tstart) {
                   4018:                 next if ($tstart > $now);
                   4019:             }
1.1058    raeburn  4020:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4021:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4022:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4023:             if ($secpart eq '') {
                   4024:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4025:                 $sec = 'none';
1.1058    raeburn  4026:                 $value .= $cnum.'/';
1.482     raeburn  4027:             } else {
                   4028:                 $cnum = $cnumpart;
                   4029:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4030:                 $value .= $cnum.'/'.$sec;
                   4031:             }
                   4032:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4033:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4034:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4035:                 }
                   4036:             } else {
                   4037:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4038:             }
1.482     raeburn  4039:         }
                   4040:     } else {
                   4041:         foreach my $key (keys(%env)) {
1.483     albertel 4042: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4043:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4044: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4045: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4046: 	        next if (%roles && !exists($roles{$role}));
                   4047: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4048:                 my $active=1;
                   4049:                 if ($starttime) {
                   4050: 		    if ($now<$starttime) { $active=0; }
                   4051:                 }
                   4052:                 if ($endtime) {
                   4053:                     if ($now>$endtime) { $active=0; }
                   4054:                 }
                   4055:                 if ($active) {
1.1058    raeburn  4056:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4057:                     if ($sec eq '') {
                   4058:                         $sec = 'none';
1.1058    raeburn  4059:                     } else {
                   4060:                         $value .= $sec;
                   4061:                     }
                   4062:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4063:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4064:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4065:                         }
                   4066:                     } else {
                   4067:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4068:                     }
1.474     raeburn  4069:                 }
                   4070:             }
1.51      www      4071:         }
                   4072:     }
1.474     raeburn  4073:     return %courses;
1.51      www      4074: }
1.37      matthew  4075: 
1.54      www      4076: ###############################################
1.474     raeburn  4077: 
                   4078: sub blockcheck {
1.1062    raeburn  4079:     my ($setters,$activity,$uname,$udom,$url) = @_;
1.490     raeburn  4080: 
                   4081:     if (!defined($udom)) {
                   4082:         $udom = $env{'user.domain'};
                   4083:     }
                   4084:     if (!defined($uname)) {
                   4085:         $uname = $env{'user.name'};
                   4086:     }
                   4087: 
                   4088:     # If uname and udom are for a course, check for blocks in the course.
                   4089: 
                   4090:     if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062    raeburn  4091:         my ($startblock,$endblock,$triggerblock) = 
                   4092:             &get_blocks($setters,$activity,$udom,$uname,$url);
                   4093:         return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4094:     }
1.474     raeburn  4095: 
1.502     raeburn  4096:     my $startblock = 0;
                   4097:     my $endblock = 0;
1.1062    raeburn  4098:     my $triggerblock = '';
1.482     raeburn  4099:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4100: 
1.490     raeburn  4101:     # If uname is for a user, and activity is course-specific, i.e.,
                   4102:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4103: 
1.490     raeburn  4104:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4105:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4106:         foreach my $key (keys(%live_courses)) {
                   4107:             if ($key ne $env{'request.course.id'}) {
                   4108:                 delete($live_courses{$key});
                   4109:             }
                   4110:         }
                   4111:     }
                   4112: 
                   4113:     my $otheruser = 0;
                   4114:     my %own_courses;
                   4115:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4116:         # Resource belongs to user other than current user.
                   4117:         $otheruser = 1;
                   4118:         # Gather courses for current user
                   4119:         %own_courses = 
                   4120:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4121:     }
                   4122: 
                   4123:     # Gather active course roles - course coordinator, instructor, 
                   4124:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4125: 
                   4126:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4127:         my ($cdom,$cnum);
                   4128:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4129:             $cdom = $env{'course.'.$course.'.domain'};
                   4130:             $cnum = $env{'course.'.$course.'.num'};
                   4131:         } else {
1.490     raeburn  4132:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4133:         }
                   4134:         my $no_ownblock = 0;
                   4135:         my $no_userblock = 0;
1.533     raeburn  4136:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4137:             # Check if current user has 'evb' priv for this
                   4138:             if (defined($own_courses{$course})) {
                   4139:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4140:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4141:                     if ($sec ne 'none') {
                   4142:                         $checkrole .= '/'.$sec;
                   4143:                     }
                   4144:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4145:                         $no_ownblock = 1;
                   4146:                         last;
                   4147:                     }
                   4148:                 }
                   4149:             }
                   4150:             # if they have 'evb' priv and are currently not playing student
                   4151:             next if (($no_ownblock) &&
                   4152:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4153:         }
1.474     raeburn  4154:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4155:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4156:             if ($sec ne 'none') {
1.482     raeburn  4157:                 $checkrole .= '/'.$sec;
1.474     raeburn  4158:             }
1.490     raeburn  4159:             if ($otheruser) {
                   4160:                 # Resource belongs to user other than current user.
                   4161:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4162:                 my (%allroles,%userroles);
                   4163:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4164:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4165:                         my ($trole,$tdom,$tnum,$tsec);
                   4166:                         if ($entry =~ /^cr/) {
                   4167:                             ($trole,$tdom,$tnum,$tsec) = 
                   4168:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4169:                         } else {
                   4170:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4171:                         }
                   4172:                         my ($spec,$area,$trest);
                   4173:                         $area = '/'.$tdom.'/'.$tnum;
                   4174:                         $trest = $tnum;
                   4175:                         if ($tsec ne '') {
                   4176:                             $area .= '/'.$tsec;
                   4177:                             $trest .= '/'.$tsec;
                   4178:                         }
                   4179:                         $spec = $trole.'.'.$area;
                   4180:                         if ($trole =~ /^cr/) {
                   4181:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4182:                                                               $tdom,$spec,$trest,$area);
                   4183:                         } else {
                   4184:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4185:                                                                 $tdom,$spec,$trest,$area);
                   4186:                         }
                   4187:                     }
                   4188:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4189:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4190:                         if ($1) {
                   4191:                             $no_userblock = 1;
                   4192:                             last;
                   4193:                         }
1.486     raeburn  4194:                     }
                   4195:                 }
1.490     raeburn  4196:             } else {
                   4197:                 # Resource belongs to current user
                   4198:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4199:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4200:                     $no_ownblock = 1;
                   4201:                     last;
                   4202:                 }
1.474     raeburn  4203:             }
                   4204:         }
                   4205:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4206:         next if (($no_ownblock) &&
1.491     albertel 4207:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4208:         next if ($no_userblock);
1.474     raeburn  4209: 
1.866     kalberla 4210:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4211:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4212:         
1.1062    raeburn  4213:         my ($start,$end,$trigger) = 
                   4214:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4215:         if (($start != 0) && 
                   4216:             (($startblock == 0) || ($startblock > $start))) {
                   4217:             $startblock = $start;
1.1062    raeburn  4218:             if ($trigger ne '') {
                   4219:                 $triggerblock = $trigger;
                   4220:             }
1.502     raeburn  4221:         }
                   4222:         if (($end != 0)  &&
                   4223:             (($endblock == 0) || ($endblock < $end))) {
                   4224:             $endblock = $end;
1.1062    raeburn  4225:             if ($trigger ne '') {
                   4226:                 $triggerblock = $trigger;
                   4227:             }
1.502     raeburn  4228:         }
1.490     raeburn  4229:     }
1.1062    raeburn  4230:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4231: }
                   4232: 
                   4233: sub get_blocks {
1.1062    raeburn  4234:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4235:     my $startblock = 0;
                   4236:     my $endblock = 0;
1.1062    raeburn  4237:     my $triggerblock = '';
1.490     raeburn  4238:     my $course = $cdom.'_'.$cnum;
                   4239:     $setters->{$course} = {};
                   4240:     $setters->{$course}{'staff'} = [];
                   4241:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4242:     $setters->{$course}{'triggers'} = [];
                   4243:     my (@blockers,%triggered);
                   4244:     my $now = time;
                   4245:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4246:     if ($activity eq 'docs') {
                   4247:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4248:         foreach my $block (@blockers) {
                   4249:             if ($block =~ /^firstaccess____(.+)$/) {
                   4250:                 my $item = $1;
                   4251:                 my $type = 'map';
                   4252:                 my $timersymb = $item;
                   4253:                 if ($item eq 'course') {
                   4254:                     $type = 'course';
                   4255:                 } elsif ($item =~ /___\d+___/) {
                   4256:                     $type = 'resource';
                   4257:                 } else {
                   4258:                     $timersymb = &Apache::lonnet::symbread($item);
                   4259:                 }
                   4260:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4261:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4262:                 $triggered{$block} = {
                   4263:                                        start => $start,
                   4264:                                        end   => $end,
                   4265:                                        type  => $type,
                   4266:                                      };
                   4267:             }
                   4268:         }
                   4269:     } else {
                   4270:         foreach my $block (keys(%commblocks)) {
                   4271:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4272:                 my ($start,$end) = ($1,$2);
                   4273:                 if ($start <= time && $end >= time) {
                   4274:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4275:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4276:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4277:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4278:                                     push(@blockers,$block);
                   4279:                                 }
                   4280:                             }
                   4281:                         }
                   4282:                     }
                   4283:                 }
                   4284:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4285:                 my $item = $1;
                   4286:                 my $timersymb = $item; 
                   4287:                 my $type = 'map';
                   4288:                 if ($item eq 'course') {
                   4289:                     $type = 'course';
                   4290:                 } elsif ($item =~ /___\d+___/) {
                   4291:                     $type = 'resource';
                   4292:                 } else {
                   4293:                     $timersymb = &Apache::lonnet::symbread($item);
                   4294:                 }
                   4295:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4296:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4297:                 if ($start && $end) {
                   4298:                     if (($start <= time) && ($end >= time)) {
                   4299:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4300:                             push(@blockers,$block);
                   4301:                             $triggered{$block} = {
                   4302:                                                    start => $start,
                   4303:                                                    end   => $end,
                   4304:                                                    type  => $type,
                   4305:                                                  };
                   4306:                         }
                   4307:                     }
1.490     raeburn  4308:                 }
1.1062    raeburn  4309:             }
                   4310:         }
                   4311:     }
                   4312:     foreach my $blocker (@blockers) {
                   4313:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4314:             &parse_block_record($commblocks{$blocker});
                   4315:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4316:         my ($start,$end,$triggertype);
                   4317:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4318:             ($start,$end) = ($1,$2);
                   4319:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4320:             $start = $triggered{$blocker}{'start'};
                   4321:             $end = $triggered{$blocker}{'end'};
                   4322:             $triggertype = $triggered{$blocker}{'type'};
                   4323:         }
                   4324:         if ($start) {
                   4325:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4326:             if ($triggertype) {
                   4327:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4328:             } else {
                   4329:                 push(@{$$setters{$course}{'triggers'}},0);
                   4330:             }
                   4331:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4332:                 $startblock = $start;
                   4333:                 if ($triggertype) {
                   4334:                     $triggerblock = $blocker;
1.474     raeburn  4335:                 }
                   4336:             }
1.1062    raeburn  4337:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4338:                $endblock = $end;
                   4339:                if ($triggertype) {
                   4340:                    $triggerblock = $blocker;
                   4341:                }
                   4342:             }
1.474     raeburn  4343:         }
                   4344:     }
1.1062    raeburn  4345:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4346: }
                   4347: 
                   4348: sub parse_block_record {
                   4349:     my ($record) = @_;
                   4350:     my ($setuname,$setudom,$title,$blocks);
                   4351:     if (ref($record) eq 'HASH') {
                   4352:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4353:         $title = &unescape($record->{'event'});
                   4354:         $blocks = $record->{'blocks'};
                   4355:     } else {
                   4356:         my @data = split(/:/,$record,3);
                   4357:         if (scalar(@data) eq 2) {
                   4358:             $title = $data[1];
                   4359:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4360:         } else {
                   4361:             ($setuname,$setudom,$title) = @data;
                   4362:         }
                   4363:         $blocks = { 'com' => 'on' };
                   4364:     }
                   4365:     return ($setuname,$setudom,$title,$blocks);
                   4366: }
                   4367: 
1.854     kalberla 4368: sub blocking_status {
1.1062    raeburn  4369:     my ($activity,$uname,$udom,$url) = @_;
1.1061    raeburn  4370:     my %setters;
1.890     droeschl 4371: 
1.1061    raeburn  4372: # check for active blocking
1.1062    raeburn  4373:     my ($startblock,$endblock,$triggerblock) = 
                   4374:         &blockcheck(\%setters,$activity,$uname,$udom,$url);
                   4375:     my $blocked = 0;
                   4376:     if ($startblock && $endblock) {
                   4377:         $blocked = 1;
                   4378:     }
1.890     droeschl 4379: 
1.1061    raeburn  4380: # caller just wants to know whether a block is active
                   4381:     if (!wantarray) { return $blocked; }
                   4382: 
                   4383: # build a link to a popup window containing the details
                   4384:     my $querystring  = "?activity=$activity";
                   4385: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4386:     if ($activity eq 'port') {
                   4387:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4388:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4389:     } elsif ($activity eq 'docs') {
                   4390:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4391:     }
1.1061    raeburn  4392: 
                   4393:     my $output .= <<'END_MYBLOCK';
                   4394: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4395:     var options = "width=" + w + ",height=" + h + ",";
                   4396:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4397:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4398:     var newWin = window.open(url, wdwName, options);
                   4399:     newWin.focus();
                   4400: }
1.890     droeschl 4401: END_MYBLOCK
1.854     kalberla 4402: 
1.1061    raeburn  4403:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4404:   
1.1061    raeburn  4405:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4406:     my $text = &mt('Communication Blocked');
                   4407:     if ($activity eq 'docs') {
                   4408:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4409:     } elsif ($activity eq 'printout') {
                   4410:         $text = &mt('Printing Blocked');
1.1062    raeburn  4411:     }
1.1061    raeburn  4412:     $output .= <<"END_BLOCK";
1.867     kalberla 4413: <div class='LC_comblock'>
1.869     kalberla 4414:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4415:   title='$text'>
                   4416:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4417:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4418:   title='$text'>$text</a>
1.867     kalberla 4419: </div>
                   4420: 
                   4421: END_BLOCK
1.474     raeburn  4422: 
1.1061    raeburn  4423:     return ($blocked, $output);
1.854     kalberla 4424: }
1.490     raeburn  4425: 
1.60      matthew  4426: ###############################################
                   4427: 
1.682     raeburn  4428: sub check_ip_acc {
                   4429:     my ($acc)=@_;
                   4430:     &Apache::lonxml::debug("acc is $acc");
                   4431:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4432:         return 1;
                   4433:     }
                   4434:     my $allowed=0;
                   4435:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4436: 
                   4437:     my $name;
                   4438:     foreach my $pattern (split(',',$acc)) {
                   4439:         $pattern =~ s/^\s*//;
                   4440:         $pattern =~ s/\s*$//;
                   4441:         if ($pattern =~ /\*$/) {
                   4442:             #35.8.*
                   4443:             $pattern=~s/\*//;
                   4444:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4445:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4446:             #35.8.3.[34-56]
                   4447:             my $low=$2;
                   4448:             my $high=$3;
                   4449:             $pattern=$1;
                   4450:             if ($ip =~ /^\Q$pattern\E/) {
                   4451:                 my $last=(split(/\./,$ip))[3];
                   4452:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4453:             }
                   4454:         } elsif ($pattern =~ /^\*/) {
                   4455:             #*.msu.edu
                   4456:             $pattern=~s/\*//;
                   4457:             if (!defined($name)) {
                   4458:                 use Socket;
                   4459:                 my $netaddr=inet_aton($ip);
                   4460:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4461:             }
                   4462:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4463:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4464:             #127.0.0.1
                   4465:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4466:         } else {
                   4467:             #some.name.com
                   4468:             if (!defined($name)) {
                   4469:                 use Socket;
                   4470:                 my $netaddr=inet_aton($ip);
                   4471:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4472:             }
                   4473:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4474:         }
                   4475:         if ($allowed) { last; }
                   4476:     }
                   4477:     return $allowed;
                   4478: }
                   4479: 
                   4480: ###############################################
                   4481: 
1.60      matthew  4482: =pod
                   4483: 
1.112     bowersj2 4484: =head1 Domain Template Functions
                   4485: 
                   4486: =over 4
                   4487: 
                   4488: =item * &determinedomain()
1.60      matthew  4489: 
                   4490: Inputs: $domain (usually will be undef)
                   4491: 
1.63      www      4492: Returns: Determines which domain should be used for designs
1.60      matthew  4493: 
                   4494: =cut
1.54      www      4495: 
1.60      matthew  4496: ###############################################
1.63      www      4497: sub determinedomain {
                   4498:     my $domain=shift;
1.531     albertel 4499:     if (! $domain) {
1.60      matthew  4500:         # Determine domain if we have not been given one
1.893     raeburn  4501:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4502:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4503:         if ($env{'request.role.domain'}) { 
                   4504:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4505:         }
                   4506:     }
1.63      www      4507:     return $domain;
                   4508: }
                   4509: ###############################################
1.517     raeburn  4510: 
1.518     albertel 4511: sub devalidate_domconfig_cache {
                   4512:     my ($udom)=@_;
                   4513:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4514: }
                   4515: 
                   4516: # ---------------------- Get domain configuration for a domain
                   4517: sub get_domainconf {
                   4518:     my ($udom) = @_;
                   4519:     my $cachetime=1800;
                   4520:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4521:     if (defined($cached)) { return %{$result}; }
                   4522: 
                   4523:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4524: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4525:     my (%designhash,%legacy);
1.518     albertel 4526:     if (keys(%domconfig) > 0) {
                   4527:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4528:             if (keys(%{$domconfig{'login'}})) {
                   4529:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4530:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4531:                         if ($key eq 'loginvia') {
                   4532:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4533:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4534:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4535:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4536:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4537:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4538:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4539: 
                   4540:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4541:                                             } else {
1.1013    raeburn  4542:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4543:                                             }
                   4544:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4545:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4546:                                             }
1.946     raeburn  4547:                                         }
                   4548:                                     }
                   4549:                                 }
                   4550:                             }
                   4551:                         } else {
                   4552:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4553:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4554:                                     $domconfig{'login'}{$key}{$img};
                   4555:                             }
1.699     raeburn  4556:                         }
                   4557:                     } else {
                   4558:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4559:                     }
1.632     raeburn  4560:                 }
                   4561:             } else {
                   4562:                 $legacy{'login'} = 1;
1.518     albertel 4563:             }
1.632     raeburn  4564:         } else {
                   4565:             $legacy{'login'} = 1;
1.518     albertel 4566:         }
                   4567:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4568:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4569:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4570:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4571:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4572:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4573:                         }
1.518     albertel 4574:                     }
                   4575:                 }
1.632     raeburn  4576:             } else {
                   4577:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4578:             }
1.632     raeburn  4579:         } else {
                   4580:             $legacy{'rolecolors'} = 1;
1.518     albertel 4581:         }
1.948     raeburn  4582:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4583:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4584:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4585:             }
                   4586:         }
1.632     raeburn  4587:         if (keys(%legacy) > 0) {
                   4588:             my %legacyhash = &get_legacy_domconf($udom);
                   4589:             foreach my $item (keys(%legacyhash)) {
                   4590:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4591:                     if ($legacy{'login'}) { 
                   4592:                         $designhash{$item} = $legacyhash{$item};
                   4593:                     }
                   4594:                 } else {
                   4595:                     if ($legacy{'rolecolors'}) {
                   4596:                         $designhash{$item} = $legacyhash{$item};
                   4597:                     }
1.518     albertel 4598:                 }
                   4599:             }
                   4600:         }
1.632     raeburn  4601:     } else {
                   4602:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4603:     }
                   4604:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4605: 				  $cachetime);
                   4606:     return %designhash;
                   4607: }
                   4608: 
1.632     raeburn  4609: sub get_legacy_domconf {
                   4610:     my ($udom) = @_;
                   4611:     my %legacyhash;
                   4612:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4613:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4614:     if (-e $designfile) {
                   4615:         if ( open (my $fh,"<$designfile") ) {
                   4616:             while (my $line = <$fh>) {
                   4617:                 next if ($line =~ /^\#/);
                   4618:                 chomp($line);
                   4619:                 my ($key,$val)=(split(/\=/,$line));
                   4620:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4621:             }
                   4622:             close($fh);
                   4623:         }
                   4624:     }
1.1026    raeburn  4625:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4626:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4627:     }
                   4628:     return %legacyhash;
                   4629: }
                   4630: 
1.63      www      4631: =pod
                   4632: 
1.112     bowersj2 4633: =item * &domainlogo()
1.63      www      4634: 
                   4635: Inputs: $domain (usually will be undef)
                   4636: 
                   4637: Returns: A link to a domain logo, if the domain logo exists.
                   4638: If the domain logo does not exist, a description of the domain.
                   4639: 
                   4640: =cut
1.112     bowersj2 4641: 
1.63      www      4642: ###############################################
                   4643: sub domainlogo {
1.517     raeburn  4644:     my $domain = &determinedomain(shift);
1.518     albertel 4645:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4646:     # See if there is a logo
                   4647:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4648:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4649:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4650: 	    if ($imgsrc =~ m{^/res/}) {
                   4651: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4652: 		&Apache::lonnet::repcopy($local_name);
                   4653: 	    }
                   4654: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4655:         } 
                   4656:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4657:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4658:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4659:     } else {
1.60      matthew  4660:         return '';
1.59      www      4661:     }
                   4662: }
1.63      www      4663: ##############################################
                   4664: 
                   4665: =pod
                   4666: 
1.112     bowersj2 4667: =item * &designparm()
1.63      www      4668: 
                   4669: Inputs: $which parameter; $domain (usually will be undef)
                   4670: 
                   4671: Returns: value of designparamter $which
                   4672: 
                   4673: =cut
1.112     bowersj2 4674: 
1.397     albertel 4675: 
1.400     albertel 4676: ##############################################
1.397     albertel 4677: sub designparm {
                   4678:     my ($which,$domain)=@_;
                   4679:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4680:         return $env{'environment.color.'.$which};
1.96      www      4681:     }
1.63      www      4682:     $domain=&determinedomain($domain);
1.1016    raeburn  4683:     my %domdesign;
                   4684:     unless ($domain eq 'public') {
                   4685:         %domdesign = &get_domainconf($domain);
                   4686:     }
1.520     raeburn  4687:     my $output;
1.517     raeburn  4688:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4689:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4690:     } else {
1.520     raeburn  4691:         $output = $defaultdesign{$which};
                   4692:     }
                   4693:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4694:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4695:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4696:             if ($output =~ m{^/res/}) {
                   4697:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4698:                 &Apache::lonnet::repcopy($local_name);
                   4699:             }
1.520     raeburn  4700:             $output = &lonhttpdurl($output);
                   4701:         }
1.63      www      4702:     }
1.520     raeburn  4703:     return $output;
1.63      www      4704: }
1.59      www      4705: 
1.822     bisitz   4706: ##############################################
                   4707: =pod
                   4708: 
1.832     bisitz   4709: =item * &authorspace()
                   4710: 
1.1028    raeburn  4711: Inputs: $url (usually will be undef).
1.832     bisitz   4712: 
1.1028    raeburn  4713: Returns: Path to Construction Space containing the resource or 
                   4714:          directory being viewed (or for which action is being taken). 
                   4715:          If $url is provided, and begins /priv/<domain>/<uname>
                   4716:          the path will be that portion of the $context argument.
                   4717:          Otherwise the path will be for the author space of the current
                   4718:          user when the current role is author, or for that of the 
                   4719:          co-author/assistant co-author space when the current role 
                   4720:          is co-author or assistant co-author.
1.832     bisitz   4721: 
                   4722: =cut
                   4723: 
                   4724: sub authorspace {
1.1028    raeburn  4725:     my ($url) = @_;
                   4726:     if ($url ne '') {
                   4727:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4728:            return $1;
                   4729:         }
                   4730:     }
1.832     bisitz   4731:     my $caname = '';
1.1024    www      4732:     my $cadom = '';
1.1028    raeburn  4733:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4734:         ($cadom,$caname) =
1.832     bisitz   4735:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4736:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4737:         $caname = $env{'user.name'};
1.1024    www      4738:         $cadom = $env{'user.domain'};
1.832     bisitz   4739:     }
1.1028    raeburn  4740:     if (($caname ne '') && ($cadom ne '')) {
                   4741:         return "/priv/$cadom/$caname/";
                   4742:     }
                   4743:     return;
1.832     bisitz   4744: }
                   4745: 
                   4746: ##############################################
                   4747: =pod
                   4748: 
1.822     bisitz   4749: =item * &head_subbox()
                   4750: 
                   4751: Inputs: $content (contains HTML code with page functions, etc.)
                   4752: 
                   4753: Returns: HTML div with $content
                   4754:          To be included in page header
                   4755: 
                   4756: =cut
                   4757: 
                   4758: sub head_subbox {
                   4759:     my ($content)=@_;
                   4760:     my $output =
1.993     raeburn  4761:         '<div class="LC_head_subbox">'
1.822     bisitz   4762:        .$content
                   4763:        .'</div>'
                   4764: }
                   4765: 
                   4766: ##############################################
                   4767: =pod
                   4768: 
                   4769: =item * &CSTR_pageheader()
                   4770: 
1.1026    raeburn  4771: Input: (optional) filename from which breadcrumb trail is built.
                   4772:        In most cases no input as needed, as $env{'request.filename'}
                   4773:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4774: 
                   4775: Returns: HTML div with CSTR path and recent box
                   4776:          To be included on Construction Space pages
                   4777: 
                   4778: =cut
                   4779: 
                   4780: sub CSTR_pageheader {
1.1026    raeburn  4781:     my ($trailfile) = @_;
                   4782:     if ($trailfile eq '') {
                   4783:         $trailfile = $env{'request.filename'};
                   4784:     }
                   4785: 
                   4786: # this is for resources; directories have customtitle, and crumbs
                   4787: # and select recent are created in lonpubdir.pm
                   4788: 
                   4789:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4790:     my ($udom,$uname,$thisdisfn)=
1.1026    raeburn  4791:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)/(.*)$});
                   4792:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4793:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4794: 
                   4795:     my $parentpath = '';
                   4796:     my $lastitem = '';
                   4797:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4798:         $parentpath = $1;
                   4799:         $lastitem = $2;
                   4800:     } else {
                   4801:         $lastitem = $thisdisfn;
                   4802:     }
1.921     bisitz   4803: 
                   4804:     my $output =
1.822     bisitz   4805:          '<div>'
                   4806:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
                   4807:         .'<b>'.&mt('Construction Space:').'</b> '
                   4808:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4809:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4810:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4811: 
                   4812:     if ($lastitem) {
                   4813:         $output .=
                   4814:              '<span class="LC_filename">'
                   4815:             .$lastitem
                   4816:             .'</span>';
                   4817:     }
                   4818:     $output .=
                   4819:          '<br />'
1.822     bisitz   4820:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4821:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4822:         .'</form>'
                   4823:         .&Apache::lonmenu::constspaceform()
                   4824:         .'</div>';
1.921     bisitz   4825: 
                   4826:     return $output;
1.822     bisitz   4827: }
                   4828: 
1.60      matthew  4829: ###############################################
                   4830: ###############################################
                   4831: 
                   4832: =pod
                   4833: 
1.112     bowersj2 4834: =back
                   4835: 
1.549     albertel 4836: =head1 HTML Helpers
1.112     bowersj2 4837: 
                   4838: =over 4
                   4839: 
                   4840: =item * &bodytag()
1.60      matthew  4841: 
                   4842: Returns a uniform header for LON-CAPA web pages.
                   4843: 
                   4844: Inputs: 
                   4845: 
1.112     bowersj2 4846: =over 4
                   4847: 
                   4848: =item * $title, A title to be displayed on the page.
                   4849: 
                   4850: =item * $function, the current role (can be undef).
                   4851: 
                   4852: =item * $addentries, extra parameters for the <body> tag.
                   4853: 
                   4854: =item * $bodyonly, if defined, only return the <body> tag.
                   4855: 
                   4856: =item * $domain, if defined, force a given domain.
                   4857: 
                   4858: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      4859:             text interface only)
1.60      matthew  4860: 
1.814     bisitz   4861: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   4862:                      navigational links
1.317     albertel 4863: 
1.338     albertel 4864: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   4865: 
1.460     albertel 4866: =item * $args, optional argument valid values are
                   4867:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 4868:             inherit_jsmath -> when creating popup window in a page,
                   4869:                               should it have jsmath forced on by the
                   4870:                               current page
1.460     albertel 4871: 
1.112     bowersj2 4872: =back
                   4873: 
1.60      matthew  4874: Returns: A uniform header for LON-CAPA web pages.  
                   4875: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   4876: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   4877: other decorations will be returned.
                   4878: 
                   4879: =cut
                   4880: 
1.54      www      4881: sub bodytag {
1.831     bisitz   4882:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.962     droeschl 4883:         $no_nav_bar,$bgcolor,$args)=@_;
1.339     albertel 4884: 
1.954     raeburn  4885:     my $public;
                   4886:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   4887:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   4888:         $public = 1;
                   4889:     }
1.460     albertel 4890:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 4891: 
1.183     matthew  4892:     $function = &get_users_function() if (!$function);
1.339     albertel 4893:     my $img =    &designparm($function.'.img',$domain);
                   4894:     my $font =   &designparm($function.'.font',$domain);
                   4895:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   4896: 
1.803     bisitz   4897:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 4898: 		   'bgcolor' => $pgbg,
1.339     albertel 4899: 		   'text'    => $font,
                   4900:                    'alink'   => &designparm($function.'.alink',$domain),
                   4901: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   4902: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 4903:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 4904: 
1.63      www      4905:  # role and realm
1.378     raeburn  4906:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   4907:     if ($role  eq 'ca') {
1.479     albertel 4908:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 4909:         $realm = &plainname($rname,$rdom);
1.378     raeburn  4910:     } 
1.55      www      4911: # realm
1.258     albertel 4912:     if ($env{'request.course.id'}) {
1.378     raeburn  4913:         if ($env{'request.role'} !~ /^cr/) {
                   4914:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   4915:         }
1.898     raeburn  4916:         if ($env{'request.course.sec'}) {
                   4917:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   4918:         }   
1.359     albertel 4919: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  4920:     } else {
                   4921:         $role = &Apache::lonnet::plaintext($role);
1.54      www      4922:     }
1.433     albertel 4923: 
1.359     albertel 4924:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 4925: 
1.438     albertel 4926:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 4927: 
1.101     www      4928: # construct main body tag
1.359     albertel 4929:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 4930: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 4931: 
1.530     albertel 4932:     if ($bodyonly) {
1.60      matthew  4933:         return $bodytag;
1.798     tempelho 4934:     } 
1.359     albertel 4935: 
1.410     albertel 4936:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
1.954     raeburn  4937:     if ($public) {
1.433     albertel 4938: 	undef($role);
1.434     albertel 4939:     } else {
1.1070    raeburn  4940: 	$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   4941:                                 undef,'LC_menubuttons_link');
1.433     albertel 4942:     }
1.359     albertel 4943:     
1.762     bisitz   4944:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 4945:     #
                   4946:     # Extra info if you are the DC
                   4947:     my $dc_info = '';
                   4948:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   4949:                         $env{'course.'.$env{'request.course.id'}.
                   4950:                                  '.domain'}.'/'})) {
                   4951:         my $cid = $env{'request.course.id'};
1.917     raeburn  4952:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      4953:         $dc_info =~ s/\s+$//;
1.359     albertel 4954:     }
                   4955: 
1.898     raeburn  4956:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 4957:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   4958: 
1.916     droeschl 4959:         if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') { 
                   4960:             return $bodytag; 
                   4961:         } 
1.903     droeschl 4962: 
                   4963:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   4964: 
                   4965:         #    if ($env{'request.state'} eq 'construct') {
                   4966:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   4967:         #    }
                   4968: 
1.359     albertel 4969: 
                   4970: 
1.916     droeschl 4971:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  4972:              if ($dc_info) {
                   4973:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   4974:              }
1.916     droeschl 4975:              $bodytag .= qq|<div id="LC_nav_bar">$name $role<br />
                   4976:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 4977:             return $bodytag;
                   4978:         }
1.894     droeschl 4979: 
1.927     raeburn  4980:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
                   4981:             $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>|;
                   4982:         }
1.916     droeschl 4983: 
1.903     droeschl 4984:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   4985:             Apache::lonmenu::utilityfunctions(), 'start');
1.816     bisitz   4986: 
1.903     droeschl 4987:         $bodytag .= Apache::lonmenu::primary_menu();
1.852     droeschl 4988: 
1.917     raeburn  4989:         if ($dc_info) {
                   4990:             $dc_info = &dc_courseid_toggle($dc_info);
                   4991:         }
                   4992:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 4993: 
1.903     droeschl 4994:         #don't show menus for public users
1.954     raeburn  4995:         if (!$public){
1.903     droeschl 4996:             $bodytag .= Apache::lonmenu::secondary_menu();
                   4997:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  4998:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   4999:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5000:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5001:                                 $args->{'bread_crumbs'});
                   5002:             } elsif ($forcereg) { 
                   5003:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg);
                   5004:             }
1.903     droeschl 5005:         }else{
                   5006:             # this is to seperate menu from content when there's no secondary
                   5007:             # menu. Especially needed for public accessible ressources.
                   5008:             $bodytag .= '<hr style="clear:both" />';
                   5009:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5010:         }
1.903     droeschl 5011: 
1.235     raeburn  5012:         return $bodytag;
1.182     matthew  5013: }
                   5014: 
1.917     raeburn  5015: sub dc_courseid_toggle {
                   5016:     my ($dc_info) = @_;
1.980     raeburn  5017:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5018:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5019:            &mt('(More ...)').'</a></span>'.
                   5020:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5021: }
                   5022: 
1.330     albertel 5023: sub make_attr_string {
                   5024:     my ($register,$attr_ref) = @_;
                   5025: 
                   5026:     if ($attr_ref && !ref($attr_ref)) {
                   5027: 	die("addentries Must be a hash ref ".
                   5028: 	    join(':',caller(1))." ".
                   5029: 	    join(':',caller(0))." ");
                   5030:     }
                   5031: 
                   5032:     if ($register) {
1.339     albertel 5033: 	my ($on_load,$on_unload);
                   5034: 	foreach my $key (keys(%{$attr_ref})) {
                   5035: 	    if      (lc($key) eq 'onload') {
                   5036: 		$on_load.=$attr_ref->{$key}.';';
                   5037: 		delete($attr_ref->{$key});
                   5038: 
                   5039: 	    } elsif (lc($key) eq 'onunload') {
                   5040: 		$on_unload.=$attr_ref->{$key}.';';
                   5041: 		delete($attr_ref->{$key});
                   5042: 	    }
                   5043: 	}
1.953     droeschl 5044: 	$attr_ref->{'onload'}  = $on_load;
                   5045: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 5046:     }
1.339     albertel 5047: 
1.330     albertel 5048:     my $attr_string;
                   5049:     foreach my $attr (keys(%$attr_ref)) {
                   5050: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5051:     }
                   5052:     return $attr_string;
                   5053: }
                   5054: 
                   5055: 
1.182     matthew  5056: ###############################################
1.251     albertel 5057: ###############################################
                   5058: 
                   5059: =pod
                   5060: 
                   5061: =item * &endbodytag()
                   5062: 
                   5063: Returns a uniform footer for LON-CAPA web pages.
                   5064: 
1.635     raeburn  5065: Inputs: 1 - optional reference to an args hash
                   5066: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5067: a 'Continue' link is not displayed if the page contains an
                   5068: internal redirect in the <head></head> section,
                   5069: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5070: 
                   5071: =cut
                   5072: 
                   5073: sub endbodytag {
1.635     raeburn  5074:     my ($args) = @_;
1.251     albertel 5075:     my $endbodytag='</body>';
1.269     albertel 5076:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5077:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5078:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5079: 	    $endbodytag=
                   5080: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5081: 	        &mt('Continue').'</a>'.
                   5082: 	        $endbodytag;
                   5083:         }
1.315     albertel 5084:     }
1.251     albertel 5085:     return $endbodytag;
                   5086: }
                   5087: 
1.352     albertel 5088: =pod
                   5089: 
                   5090: =item * &standard_css()
                   5091: 
                   5092: Returns a style sheet
                   5093: 
                   5094: Inputs: (all optional)
                   5095:             domain         -> force to color decorate a page for a specific
                   5096:                                domain
                   5097:             function       -> force usage of a specific rolish color scheme
                   5098:             bgcolor        -> override the default page bgcolor
                   5099: 
                   5100: =cut
                   5101: 
1.343     albertel 5102: sub standard_css {
1.345     albertel 5103:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5104:     $function  = &get_users_function() if (!$function);
                   5105:     my $img    = &designparm($function.'.img',   $domain);
                   5106:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5107:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5108:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5109: #second colour for later usage
1.345     albertel 5110:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5111:     my $pgbg_or_bgcolor =
                   5112: 	         $bgcolor ||
1.352     albertel 5113: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5114:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5115:     my $alink  = &designparm($function.'.alink', $domain);
                   5116:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5117:     my $link   = &designparm($function.'.link',  $domain);
                   5118: 
1.602     albertel 5119:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5120:     my $mono                 = 'monospace';
1.850     bisitz   5121:     my $data_table_head      = $sidebg;
                   5122:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5123:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5124:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5125:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5126:     my $mail_new             = '#FFBB77';
                   5127:     my $mail_new_hover       = '#DD9955';
                   5128:     my $mail_read            = '#BBBB77';
                   5129:     my $mail_read_hover      = '#999944';
                   5130:     my $mail_replied         = '#AAAA88';
                   5131:     my $mail_replied_hover   = '#888855';
                   5132:     my $mail_other           = '#99BBBB';
                   5133:     my $mail_other_hover     = '#669999';
1.391     albertel 5134:     my $table_header         = '#DDDDDD';
1.489     raeburn  5135:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5136:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5137:     my $button_hover         = '#BF2317';
1.392     albertel 5138: 
1.608     albertel 5139:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5140:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5141:                                              : '0 3px 0 4px';
1.448     albertel 5142: 
1.523     albertel 5143: 
1.343     albertel 5144:     return <<END;
1.947     droeschl 5145: 
                   5146: /* needed for iframe to allow 100% height in FF */
                   5147: body, html { 
                   5148:     margin: 0;
                   5149:     padding: 0 0.5%;
                   5150:     height: 99%; /* to avoid scrollbars */
                   5151: }
                   5152: 
1.795     www      5153: body {
1.911     bisitz   5154:   font-family: $sans;
                   5155:   line-height:130%;
                   5156:   font-size:0.83em;
                   5157:   color:$font;
1.795     www      5158: }
                   5159: 
1.959     onken    5160: a:focus,
                   5161: a:focus img {
1.795     www      5162:   color: red;
                   5163: }
1.698     harmsja  5164: 
1.911     bisitz   5165: form, .inline {
                   5166:   display: inline;
1.795     www      5167: }
1.721     harmsja  5168: 
1.795     www      5169: .LC_right {
1.911     bisitz   5170:   text-align:right;
1.795     www      5171: }
                   5172: 
                   5173: .LC_middle {
1.911     bisitz   5174:   vertical-align:middle;
1.795     www      5175: }
1.721     harmsja  5176: 
1.911     bisitz   5177: .LC_400Box {
                   5178:   width:400px;
                   5179: }
1.721     harmsja  5180: 
1.947     droeschl 5181: .LC_iframecontainer {
                   5182:     width: 98%;
                   5183:     margin: 0;
                   5184:     position: fixed;
                   5185:     top: 8.5em;
                   5186:     bottom: 0;
                   5187: }
                   5188: 
                   5189: .LC_iframecontainer iframe{
                   5190:     border: none;
                   5191:     width: 100%;
                   5192:     height: 100%;
                   5193: }
                   5194: 
1.778     bisitz   5195: .LC_filename {
                   5196:   font-family: $mono;
                   5197:   white-space:pre;
1.921     bisitz   5198:   font-size: 120%;
1.778     bisitz   5199: }
                   5200: 
                   5201: .LC_fileicon {
                   5202:   border: none;
                   5203:   height: 1.3em;
                   5204:   vertical-align: text-bottom;
                   5205:   margin-right: 0.3em;
                   5206:   text-decoration:none;
                   5207: }
                   5208: 
1.1008    www      5209: .LC_setting {
                   5210:   text-decoration:underline;
                   5211: }
                   5212: 
1.350     albertel 5213: .LC_error {
                   5214:   color: red;
                   5215:   font-size: larger;
                   5216: }
1.795     www      5217: 
1.457     albertel 5218: .LC_warning,
                   5219: .LC_diff_removed {
1.733     bisitz   5220:   color: red;
1.394     albertel 5221: }
1.532     albertel 5222: 
                   5223: .LC_info,
1.457     albertel 5224: .LC_success,
                   5225: .LC_diff_added {
1.350     albertel 5226:   color: green;
                   5227: }
1.795     www      5228: 
1.802     bisitz   5229: div.LC_confirm_box {
                   5230:   background-color: #FAFAFA;
                   5231:   border: 1px solid $lg_border_color;
                   5232:   margin-right: 0;
                   5233:   padding: 5px;
                   5234: }
                   5235: 
                   5236: div.LC_confirm_box .LC_error img,
                   5237: div.LC_confirm_box .LC_success img {
                   5238:   vertical-align: middle;
                   5239: }
                   5240: 
1.440     albertel 5241: .LC_icon {
1.771     droeschl 5242:   border: none;
1.790     droeschl 5243:   vertical-align: middle;
1.771     droeschl 5244: }
                   5245: 
1.543     albertel 5246: .LC_docs_spacer {
                   5247:   width: 25px;
                   5248:   height: 1px;
1.771     droeschl 5249:   border: none;
1.543     albertel 5250: }
1.346     albertel 5251: 
1.532     albertel 5252: .LC_internal_info {
1.735     bisitz   5253:   color: #999999;
1.532     albertel 5254: }
                   5255: 
1.794     www      5256: .LC_discussion {
1.1050    www      5257:   background: $data_table_dark;
1.911     bisitz   5258:   border: 1px solid black;
                   5259:   margin: 2px;
1.794     www      5260: }
                   5261: 
                   5262: .LC_disc_action_left {
1.1050    www      5263:   background: $sidebg;
1.911     bisitz   5264:   text-align: left;
1.1050    www      5265:   padding: 4px;
                   5266:   margin: 2px;
1.794     www      5267: }
                   5268: 
                   5269: .LC_disc_action_right {
1.1050    www      5270:   background: $sidebg;
1.911     bisitz   5271:   text-align: right;
1.1050    www      5272:   padding: 4px;
                   5273:   margin: 2px;
1.794     www      5274: }
                   5275: 
                   5276: .LC_disc_new_item {
1.911     bisitz   5277:   background: white;
                   5278:   border: 2px solid red;
1.1050    www      5279:   margin: 4px;
                   5280:   padding: 4px;
1.794     www      5281: }
                   5282: 
                   5283: .LC_disc_old_item {
1.911     bisitz   5284:   background: white;
1.1050    www      5285:   margin: 4px;
                   5286:   padding: 4px;
1.794     www      5287: }
                   5288: 
1.458     albertel 5289: table.LC_pastsubmission {
                   5290:   border: 1px solid black;
                   5291:   margin: 2px;
                   5292: }
                   5293: 
1.924     bisitz   5294: table#LC_menubuttons {
1.345     albertel 5295:   width: 100%;
                   5296:   background: $pgbg;
1.392     albertel 5297:   border: 2px;
1.402     albertel 5298:   border-collapse: separate;
1.803     bisitz   5299:   padding: 0;
1.345     albertel 5300: }
1.392     albertel 5301: 
1.801     tempelho 5302: table#LC_title_bar a {
                   5303:   color: $fontmenu;
                   5304: }
1.836     bisitz   5305: 
1.807     droeschl 5306: table#LC_title_bar {
1.819     tempelho 5307:   clear: both;
1.836     bisitz   5308:   display: none;
1.807     droeschl 5309: }
                   5310: 
1.795     www      5311: table#LC_title_bar,
1.933     droeschl 5312: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5313: table#LC_title_bar.LC_with_remote {
1.359     albertel 5314:   width: 100%;
1.392     albertel 5315:   border-color: $pgbg;
                   5316:   border-style: solid;
                   5317:   border-width: $border;
1.379     albertel 5318:   background: $pgbg;
1.801     tempelho 5319:   color: $fontmenu;
1.392     albertel 5320:   border-collapse: collapse;
1.803     bisitz   5321:   padding: 0;
1.819     tempelho 5322:   margin: 0;
1.359     albertel 5323: }
1.795     www      5324: 
1.933     droeschl 5325: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5326:     margin: 0;
                   5327:     padding: 0;
1.933     droeschl 5328:     position: relative;
                   5329:     list-style: none;
1.913     droeschl 5330: }
1.933     droeschl 5331: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5332:     display: inline;
                   5333: }
1.933     droeschl 5334: 
                   5335: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5336:     padding: 0;
1.933     droeschl 5337:     margin: 0;
                   5338:     float: left;
1.913     droeschl 5339: }
1.933     droeschl 5340: .LC_breadcrumb_tools_tools {
                   5341:     padding: 0;
                   5342:     margin: 0;
1.913     droeschl 5343:     float: right;
                   5344: }
                   5345: 
1.359     albertel 5346: table#LC_title_bar td {
                   5347:   background: $tabbg;
                   5348: }
1.795     www      5349: 
1.911     bisitz   5350: table#LC_menubuttons img {
1.803     bisitz   5351:   border: none;
1.346     albertel 5352: }
1.795     www      5353: 
1.842     droeschl 5354: .LC_breadcrumbs_component {
1.911     bisitz   5355:   float: right;
                   5356:   margin: 0 1em;
1.357     albertel 5357: }
1.842     droeschl 5358: .LC_breadcrumbs_component img {
1.911     bisitz   5359:   vertical-align: middle;
1.777     tempelho 5360: }
1.795     www      5361: 
1.383     albertel 5362: td.LC_table_cell_checkbox {
                   5363:   text-align: center;
                   5364: }
1.795     www      5365: 
                   5366: .LC_fontsize_small {
1.911     bisitz   5367:   font-size: 70%;
1.705     tempelho 5368: }
                   5369: 
1.844     bisitz   5370: #LC_breadcrumbs {
1.911     bisitz   5371:   clear:both;
                   5372:   background: $sidebg;
                   5373:   border-bottom: 1px solid $lg_border_color;
                   5374:   line-height: 2.5em;
1.933     droeschl 5375:   overflow: hidden;
1.911     bisitz   5376:   margin: 0;
                   5377:   padding: 0;
1.995     raeburn  5378:   text-align: left;
1.819     tempelho 5379: }
1.862     bisitz   5380: 
1.993     raeburn  5381: .LC_head_subbox {
1.911     bisitz   5382:   clear:both;
                   5383:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5384:   border: 1px solid $sidebg;
                   5385:   margin: 0 0 10px 0;      
1.966     bisitz   5386:   padding: 3px;
1.995     raeburn  5387:   text-align: left;
1.822     bisitz   5388: }
                   5389: 
1.795     www      5390: .LC_fontsize_medium {
1.911     bisitz   5391:   font-size: 85%;
1.705     tempelho 5392: }
                   5393: 
1.795     www      5394: .LC_fontsize_large {
1.911     bisitz   5395:   font-size: 120%;
1.705     tempelho 5396: }
                   5397: 
1.346     albertel 5398: .LC_menubuttons_inline_text {
                   5399:   color: $font;
1.698     harmsja  5400:   font-size: 90%;
1.701     harmsja  5401:   padding-left:3px;
1.346     albertel 5402: }
                   5403: 
1.934     droeschl 5404: .LC_menubuttons_inline_text img{
                   5405:   vertical-align: middle;
                   5406: }
                   5407: 
1.1051    www      5408: li.LC_menubuttons_inline_text img {
1.951     onken    5409:   cursor:pointer;
1.1002    droeschl 5410:   text-decoration: none;
1.951     onken    5411: }
                   5412: 
1.526     www      5413: .LC_menubuttons_link {
                   5414:   text-decoration: none;
                   5415: }
1.795     www      5416: 
1.522     albertel 5417: .LC_menubuttons_category {
1.521     www      5418:   color: $font;
1.526     www      5419:   background: $pgbg;
1.521     www      5420:   font-size: larger;
                   5421:   font-weight: bold;
                   5422: }
                   5423: 
1.346     albertel 5424: td.LC_menubuttons_text {
1.911     bisitz   5425:   color: $font;
1.346     albertel 5426: }
1.706     harmsja  5427: 
1.346     albertel 5428: .LC_current_location {
                   5429:   background: $tabbg;
                   5430: }
1.795     www      5431: 
1.938     bisitz   5432: table.LC_data_table {
1.347     albertel 5433:   border: 1px solid #000000;
1.402     albertel 5434:   border-collapse: separate;
1.426     albertel 5435:   border-spacing: 1px;
1.610     albertel 5436:   background: $pgbg;
1.347     albertel 5437: }
1.795     www      5438: 
1.422     albertel 5439: .LC_data_table_dense {
                   5440:   font-size: small;
                   5441: }
1.795     www      5442: 
1.507     raeburn  5443: table.LC_nested_outer {
                   5444:   border: 1px solid #000000;
1.589     raeburn  5445:   border-collapse: collapse;
1.803     bisitz   5446:   border-spacing: 0;
1.507     raeburn  5447:   width: 100%;
                   5448: }
1.795     www      5449: 
1.879     raeburn  5450: table.LC_innerpickbox,
1.507     raeburn  5451: table.LC_nested {
1.803     bisitz   5452:   border: none;
1.589     raeburn  5453:   border-collapse: collapse;
1.803     bisitz   5454:   border-spacing: 0;
1.507     raeburn  5455:   width: 100%;
                   5456: }
1.795     www      5457: 
1.911     bisitz   5458: table.LC_data_table tr th,
                   5459: table.LC_calendar tr th,
1.879     raeburn  5460: table.LC_prior_tries tr th,
                   5461: table.LC_innerpickbox tr th {
1.349     albertel 5462:   font-weight: bold;
                   5463:   background-color: $data_table_head;
1.801     tempelho 5464:   color:$fontmenu;
1.701     harmsja  5465:   font-size:90%;
1.347     albertel 5466: }
1.795     www      5467: 
1.879     raeburn  5468: table.LC_innerpickbox tr th,
                   5469: table.LC_innerpickbox tr td {
                   5470:   vertical-align: top;
                   5471: }
                   5472: 
1.711     raeburn  5473: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5474:   background-color: #CCCCCC;
1.711     raeburn  5475:   font-weight: bold;
                   5476:   text-align: left;
                   5477: }
1.795     www      5478: 
1.912     bisitz   5479: table.LC_data_table tr.LC_odd_row > td {
                   5480:   background-color: $data_table_light;
                   5481:   padding: 2px;
                   5482:   vertical-align: top;
                   5483: }
                   5484: 
1.809     bisitz   5485: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5486:   background-color: $data_table_light;
1.912     bisitz   5487:   vertical-align: top;
                   5488: }
                   5489: 
                   5490: table.LC_data_table tr.LC_even_row > td {
                   5491:   background-color: $data_table_dark;
1.425     albertel 5492:   padding: 2px;
1.900     bisitz   5493:   vertical-align: top;
1.347     albertel 5494: }
1.795     www      5495: 
1.809     bisitz   5496: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5497:   background-color: $data_table_dark;
1.900     bisitz   5498:   vertical-align: top;
1.347     albertel 5499: }
1.795     www      5500: 
1.425     albertel 5501: table.LC_data_table tr.LC_data_table_highlight td {
                   5502:   background-color: $data_table_darker;
                   5503: }
1.795     www      5504: 
1.639     raeburn  5505: table.LC_data_table tr td.LC_leftcol_header {
                   5506:   background-color: $data_table_head;
                   5507:   font-weight: bold;
                   5508: }
1.795     www      5509: 
1.451     albertel 5510: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5511: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5512:   font-weight: bold;
                   5513:   font-style: italic;
                   5514:   text-align: center;
                   5515:   padding: 8px;
1.347     albertel 5516: }
1.795     www      5517: 
1.940     bisitz   5518: table.LC_data_table tr.LC_empty_row td {
                   5519:   background-color: $sidebg;
                   5520: }
                   5521: 
                   5522: table.LC_nested tr.LC_empty_row td {
                   5523:   background-color: #FFFFFF;
                   5524: }
                   5525: 
1.890     droeschl 5526: table.LC_caption {
                   5527: }
                   5528: 
1.507     raeburn  5529: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5530:   padding: 4ex
                   5531: }
1.795     www      5532: 
1.507     raeburn  5533: table.LC_nested_outer tr th {
                   5534:   font-weight: bold;
1.801     tempelho 5535:   color:$fontmenu;
1.507     raeburn  5536:   background-color: $data_table_head;
1.701     harmsja  5537:   font-size: small;
1.507     raeburn  5538:   border-bottom: 1px solid #000000;
                   5539: }
1.795     www      5540: 
1.507     raeburn  5541: table.LC_nested_outer tr td.LC_subheader {
                   5542:   background-color: $data_table_head;
                   5543:   font-weight: bold;
                   5544:   font-size: small;
                   5545:   border-bottom: 1px solid #000000;
                   5546:   text-align: right;
1.451     albertel 5547: }
1.795     www      5548: 
1.507     raeburn  5549: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5550:   background-color: #CCCCCC;
1.451     albertel 5551:   font-weight: bold;
                   5552:   font-size: small;
1.507     raeburn  5553:   text-align: center;
                   5554: }
1.795     www      5555: 
1.589     raeburn  5556: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5557: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5558:   text-align: left;
1.451     albertel 5559: }
1.795     www      5560: 
1.507     raeburn  5561: table.LC_nested td {
1.735     bisitz   5562:   background-color: #FFFFFF;
1.451     albertel 5563:   font-size: small;
1.507     raeburn  5564: }
1.795     www      5565: 
1.507     raeburn  5566: table.LC_nested_outer tr th.LC_right_item,
                   5567: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5568: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5569: table.LC_nested tr td.LC_right_item {
1.451     albertel 5570:   text-align: right;
                   5571: }
                   5572: 
1.507     raeburn  5573: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5574:   background-color: #EEEEEE;
1.451     albertel 5575: }
                   5576: 
1.473     raeburn  5577: table.LC_createuser {
                   5578: }
                   5579: 
                   5580: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5581:   font-size: small;
1.473     raeburn  5582: }
                   5583: 
                   5584: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5585:   background-color: #CCCCCC;
1.473     raeburn  5586:   font-weight: bold;
                   5587:   text-align: center;
                   5588: }
                   5589: 
1.349     albertel 5590: table.LC_calendar {
                   5591:   border: 1px solid #000000;
                   5592:   border-collapse: collapse;
1.917     raeburn  5593:   width: 98%;
1.349     albertel 5594: }
1.795     www      5595: 
1.349     albertel 5596: table.LC_calendar_pickdate {
                   5597:   font-size: xx-small;
                   5598: }
1.795     www      5599: 
1.349     albertel 5600: table.LC_calendar tr td {
                   5601:   border: 1px solid #000000;
                   5602:   vertical-align: top;
1.917     raeburn  5603:   width: 14%;
1.349     albertel 5604: }
1.795     www      5605: 
1.349     albertel 5606: table.LC_calendar tr td.LC_calendar_day_empty {
                   5607:   background-color: $data_table_dark;
                   5608: }
1.795     www      5609: 
1.779     bisitz   5610: table.LC_calendar tr td.LC_calendar_day_current {
                   5611:   background-color: $data_table_highlight;
1.777     tempelho 5612: }
1.795     www      5613: 
1.938     bisitz   5614: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5615:   background-color: $mail_new;
                   5616: }
1.795     www      5617: 
1.938     bisitz   5618: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5619:   background-color: $mail_new_hover;
                   5620: }
1.795     www      5621: 
1.938     bisitz   5622: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5623:   background-color: $mail_read;
                   5624: }
1.795     www      5625: 
1.938     bisitz   5626: /*
                   5627: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5628:   background-color: $mail_read_hover;
                   5629: }
1.938     bisitz   5630: */
1.795     www      5631: 
1.938     bisitz   5632: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5633:   background-color: $mail_replied;
                   5634: }
1.795     www      5635: 
1.938     bisitz   5636: /*
                   5637: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5638:   background-color: $mail_replied_hover;
                   5639: }
1.938     bisitz   5640: */
1.795     www      5641: 
1.938     bisitz   5642: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5643:   background-color: $mail_other;
                   5644: }
1.795     www      5645: 
1.938     bisitz   5646: /*
                   5647: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5648:   background-color: $mail_other_hover;
                   5649: }
1.938     bisitz   5650: */
1.494     raeburn  5651: 
1.777     tempelho 5652: table.LC_data_table tr > td.LC_browser_file,
                   5653: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5654:   background: #AAEE77;
1.389     albertel 5655: }
1.795     www      5656: 
1.777     tempelho 5657: table.LC_data_table tr > td.LC_browser_file_locked,
                   5658: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5659:   background: #FFAA99;
1.387     albertel 5660: }
1.795     www      5661: 
1.777     tempelho 5662: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5663:   background: #888888;
1.779     bisitz   5664: }
1.795     www      5665: 
1.777     tempelho 5666: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5667: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5668:   background: #F8F866;
1.777     tempelho 5669: }
1.795     www      5670: 
1.696     bisitz   5671: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5672:   background: #E0E8FF;
1.387     albertel 5673: }
1.696     bisitz   5674: 
1.707     bisitz   5675: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5676:   /* background: #77FF77; */
1.707     bisitz   5677: }
1.795     www      5678: 
1.707     bisitz   5679: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5680:   border-right: 8px solid #FFFF77;
1.707     bisitz   5681: }
1.795     www      5682: 
1.707     bisitz   5683: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5684:   border-right: 8px solid #FFAA77;
1.707     bisitz   5685: }
1.795     www      5686: 
1.707     bisitz   5687: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5688:   border-right: 8px solid #FF7777;
1.707     bisitz   5689: }
1.795     www      5690: 
1.707     bisitz   5691: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5692:   border-right: 8px solid #AAFF77;
1.707     bisitz   5693: }
1.795     www      5694: 
1.707     bisitz   5695: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5696:   border-right: 8px solid #11CC55;
1.707     bisitz   5697: }
                   5698: 
1.388     albertel 5699: span.LC_current_location {
1.701     harmsja  5700:   font-size:larger;
1.388     albertel 5701:   background: $pgbg;
                   5702: }
1.387     albertel 5703: 
1.1029    www      5704: span.LC_current_nav_location {
                   5705:   font-weight:bold;
                   5706:   background: $sidebg;
                   5707: }
                   5708: 
1.395     albertel 5709: span.LC_parm_menu_item {
                   5710:   font-size: larger;
                   5711: }
1.795     www      5712: 
1.395     albertel 5713: span.LC_parm_scope_all {
                   5714:   color: red;
                   5715: }
1.795     www      5716: 
1.395     albertel 5717: span.LC_parm_scope_folder {
                   5718:   color: green;
                   5719: }
1.795     www      5720: 
1.395     albertel 5721: span.LC_parm_scope_resource {
                   5722:   color: orange;
                   5723: }
1.795     www      5724: 
1.395     albertel 5725: span.LC_parm_part {
                   5726:   color: blue;
                   5727: }
1.795     www      5728: 
1.911     bisitz   5729: span.LC_parm_folder,
                   5730: span.LC_parm_symb {
1.395     albertel 5731:   font-size: x-small;
                   5732:   font-family: $mono;
                   5733:   color: #AAAAAA;
                   5734: }
                   5735: 
1.977     bisitz   5736: ul.LC_parm_parmlist li {
                   5737:   display: inline-block;
                   5738:   padding: 0.3em 0.8em;
                   5739:   vertical-align: top;
                   5740:   width: 150px;
                   5741:   border-top:1px solid $lg_border_color;
                   5742: }
                   5743: 
1.795     www      5744: td.LC_parm_overview_level_menu,
                   5745: td.LC_parm_overview_map_menu,
                   5746: td.LC_parm_overview_parm_selectors,
                   5747: td.LC_parm_overview_restrictions  {
1.396     albertel 5748:   border: 1px solid black;
                   5749:   border-collapse: collapse;
                   5750: }
1.795     www      5751: 
1.396     albertel 5752: table.LC_parm_overview_restrictions td {
                   5753:   border-width: 1px 4px 1px 4px;
                   5754:   border-style: solid;
                   5755:   border-color: $pgbg;
                   5756:   text-align: center;
                   5757: }
1.795     www      5758: 
1.396     albertel 5759: table.LC_parm_overview_restrictions th {
                   5760:   background: $tabbg;
                   5761:   border-width: 1px 4px 1px 4px;
                   5762:   border-style: solid;
                   5763:   border-color: $pgbg;
                   5764: }
1.795     www      5765: 
1.398     albertel 5766: table#LC_helpmenu {
1.803     bisitz   5767:   border: none;
1.398     albertel 5768:   height: 55px;
1.803     bisitz   5769:   border-spacing: 0;
1.398     albertel 5770: }
                   5771: 
                   5772: table#LC_helpmenu fieldset legend {
                   5773:   font-size: larger;
                   5774: }
1.795     www      5775: 
1.397     albertel 5776: table#LC_helpmenu_links {
                   5777:   width: 100%;
                   5778:   border: 1px solid black;
                   5779:   background: $pgbg;
1.803     bisitz   5780:   padding: 0;
1.397     albertel 5781:   border-spacing: 1px;
                   5782: }
1.795     www      5783: 
1.397     albertel 5784: table#LC_helpmenu_links tr td {
                   5785:   padding: 1px;
                   5786:   background: $tabbg;
1.399     albertel 5787:   text-align: center;
                   5788:   font-weight: bold;
1.397     albertel 5789: }
1.396     albertel 5790: 
1.795     www      5791: table#LC_helpmenu_links a:link,
                   5792: table#LC_helpmenu_links a:visited,
1.397     albertel 5793: table#LC_helpmenu_links a:active {
                   5794:   text-decoration: none;
                   5795:   color: $font;
                   5796: }
1.795     www      5797: 
1.397     albertel 5798: table#LC_helpmenu_links a:hover {
                   5799:   text-decoration: underline;
                   5800:   color: $vlink;
                   5801: }
1.396     albertel 5802: 
1.417     albertel 5803: .LC_chrt_popup_exists {
                   5804:   border: 1px solid #339933;
                   5805:   margin: -1px;
                   5806: }
1.795     www      5807: 
1.417     albertel 5808: .LC_chrt_popup_up {
                   5809:   border: 1px solid yellow;
                   5810:   margin: -1px;
                   5811: }
1.795     www      5812: 
1.417     albertel 5813: .LC_chrt_popup {
                   5814:   border: 1px solid #8888FF;
                   5815:   background: #CCCCFF;
                   5816: }
1.795     www      5817: 
1.421     albertel 5818: table.LC_pick_box {
                   5819:   border-collapse: separate;
                   5820:   background: white;
                   5821:   border: 1px solid black;
                   5822:   border-spacing: 1px;
                   5823: }
1.795     www      5824: 
1.421     albertel 5825: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   5826:   background: $sidebg;
1.421     albertel 5827:   font-weight: bold;
1.900     bisitz   5828:   text-align: left;
1.740     bisitz   5829:   vertical-align: top;
1.421     albertel 5830:   width: 184px;
                   5831:   padding: 8px;
                   5832: }
1.795     www      5833: 
1.579     raeburn  5834: table.LC_pick_box td.LC_pick_box_value {
                   5835:   text-align: left;
                   5836:   padding: 8px;
                   5837: }
1.795     www      5838: 
1.579     raeburn  5839: table.LC_pick_box td.LC_pick_box_select {
                   5840:   text-align: left;
                   5841:   padding: 8px;
                   5842: }
1.795     www      5843: 
1.424     albertel 5844: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   5845:   padding: 0;
1.421     albertel 5846:   height: 1px;
                   5847:   background: black;
                   5848: }
1.795     www      5849: 
1.421     albertel 5850: table.LC_pick_box td.LC_pick_box_submit {
                   5851:   text-align: right;
                   5852: }
1.795     www      5853: 
1.579     raeburn  5854: table.LC_pick_box td.LC_evenrow_value {
                   5855:   text-align: left;
                   5856:   padding: 8px;
                   5857:   background-color: $data_table_light;
                   5858: }
1.795     www      5859: 
1.579     raeburn  5860: table.LC_pick_box td.LC_oddrow_value {
                   5861:   text-align: left;
                   5862:   padding: 8px;
                   5863:   background-color: $data_table_light;
                   5864: }
1.795     www      5865: 
1.579     raeburn  5866: span.LC_helpform_receipt_cat {
                   5867:   font-weight: bold;
                   5868: }
1.795     www      5869: 
1.424     albertel 5870: table.LC_group_priv_box {
                   5871:   background: white;
                   5872:   border: 1px solid black;
                   5873:   border-spacing: 1px;
                   5874: }
1.795     www      5875: 
1.424     albertel 5876: table.LC_group_priv_box td.LC_pick_box_title {
                   5877:   background: $tabbg;
                   5878:   font-weight: bold;
                   5879:   text-align: right;
                   5880:   width: 184px;
                   5881: }
1.795     www      5882: 
1.424     albertel 5883: table.LC_group_priv_box td.LC_groups_fixed {
                   5884:   background: $data_table_light;
                   5885:   text-align: center;
                   5886: }
1.795     www      5887: 
1.424     albertel 5888: table.LC_group_priv_box td.LC_groups_optional {
                   5889:   background: $data_table_dark;
                   5890:   text-align: center;
                   5891: }
1.795     www      5892: 
1.424     albertel 5893: table.LC_group_priv_box td.LC_groups_functionality {
                   5894:   background: $data_table_darker;
                   5895:   text-align: center;
                   5896:   font-weight: bold;
                   5897: }
1.795     www      5898: 
1.424     albertel 5899: table.LC_group_priv td {
                   5900:   text-align: left;
1.803     bisitz   5901:   padding: 0;
1.424     albertel 5902: }
                   5903: 
                   5904: .LC_navbuttons {
                   5905:   margin: 2ex 0ex 2ex 0ex;
                   5906: }
1.795     www      5907: 
1.423     albertel 5908: .LC_topic_bar {
                   5909:   font-weight: bold;
                   5910:   background: $tabbg;
1.918     wenzelju 5911:   margin: 1em 0em 1em 2em;
1.805     bisitz   5912:   padding: 3px;
1.918     wenzelju 5913:   font-size: 1.2em;
1.423     albertel 5914: }
1.795     www      5915: 
1.423     albertel 5916: .LC_topic_bar span {
1.918     wenzelju 5917:   left: 0.5em;
                   5918:   position: absolute;
1.423     albertel 5919:   vertical-align: middle;
1.918     wenzelju 5920:   font-size: 1.2em;
1.423     albertel 5921: }
1.795     www      5922: 
1.423     albertel 5923: table.LC_course_group_status {
                   5924:   margin: 20px;
                   5925: }
1.795     www      5926: 
1.423     albertel 5927: table.LC_status_selector td {
                   5928:   vertical-align: top;
                   5929:   text-align: center;
1.424     albertel 5930:   padding: 4px;
                   5931: }
1.795     www      5932: 
1.599     albertel 5933: div.LC_feedback_link {
1.616     albertel 5934:   clear: both;
1.829     kalberla 5935:   background: $sidebg;
1.779     bisitz   5936:   width: 100%;
1.829     kalberla 5937:   padding-bottom: 10px;
                   5938:   border: 1px $tabbg solid;
1.833     kalberla 5939:   height: 22px;
                   5940:   line-height: 22px;
                   5941:   padding-top: 5px;
                   5942: }
                   5943: 
                   5944: div.LC_feedback_link img {
                   5945:   height: 22px;
1.867     kalberla 5946:   vertical-align:middle;
1.829     kalberla 5947: }
                   5948: 
1.911     bisitz   5949: div.LC_feedback_link a {
1.829     kalberla 5950:   text-decoration: none;
1.489     raeburn  5951: }
1.795     www      5952: 
1.867     kalberla 5953: div.LC_comblock {
1.911     bisitz   5954:   display:inline;
1.867     kalberla 5955:   color:$font;
                   5956:   font-size:90%;
                   5957: }
                   5958: 
                   5959: div.LC_feedback_link div.LC_comblock {
                   5960:   padding-left:5px;
                   5961: }
                   5962: 
                   5963: div.LC_feedback_link div.LC_comblock a {
                   5964:   color:$font;
                   5965: }
                   5966: 
1.489     raeburn  5967: span.LC_feedback_link {
1.858     bisitz   5968:   /* background: $feedback_link_bg; */
1.599     albertel 5969:   font-size: larger;
                   5970: }
1.795     www      5971: 
1.599     albertel 5972: span.LC_message_link {
1.858     bisitz   5973:   /* background: $feedback_link_bg; */
1.599     albertel 5974:   font-size: larger;
                   5975:   position: absolute;
                   5976:   right: 1em;
1.489     raeburn  5977: }
1.421     albertel 5978: 
1.515     albertel 5979: table.LC_prior_tries {
1.524     albertel 5980:   border: 1px solid #000000;
                   5981:   border-collapse: separate;
                   5982:   border-spacing: 1px;
1.515     albertel 5983: }
1.523     albertel 5984: 
1.515     albertel 5985: table.LC_prior_tries td {
1.524     albertel 5986:   padding: 2px;
1.515     albertel 5987: }
1.523     albertel 5988: 
                   5989: .LC_answer_correct {
1.795     www      5990:   background: lightgreen;
                   5991:   color: darkgreen;
                   5992:   padding: 6px;
1.523     albertel 5993: }
1.795     www      5994: 
1.523     albertel 5995: .LC_answer_charged_try {
1.797     www      5996:   background: #FFAAAA;
1.795     www      5997:   color: darkred;
                   5998:   padding: 6px;
1.523     albertel 5999: }
1.795     www      6000: 
1.779     bisitz   6001: .LC_answer_not_charged_try,
1.523     albertel 6002: .LC_answer_no_grade,
                   6003: .LC_answer_late {
1.795     www      6004:   background: lightyellow;
1.523     albertel 6005:   color: black;
1.795     www      6006:   padding: 6px;
1.523     albertel 6007: }
1.795     www      6008: 
1.523     albertel 6009: .LC_answer_previous {
1.795     www      6010:   background: lightblue;
                   6011:   color: darkblue;
                   6012:   padding: 6px;
1.523     albertel 6013: }
1.795     www      6014: 
1.779     bisitz   6015: .LC_answer_no_message {
1.777     tempelho 6016:   background: #FFFFFF;
                   6017:   color: black;
1.795     www      6018:   padding: 6px;
1.779     bisitz   6019: }
1.795     www      6020: 
1.779     bisitz   6021: .LC_answer_unknown {
                   6022:   background: orange;
                   6023:   color: black;
1.795     www      6024:   padding: 6px;
1.777     tempelho 6025: }
1.795     www      6026: 
1.529     albertel 6027: span.LC_prior_numerical,
                   6028: span.LC_prior_string,
                   6029: span.LC_prior_custom,
                   6030: span.LC_prior_reaction,
                   6031: span.LC_prior_math {
1.925     bisitz   6032:   font-family: $mono;
1.523     albertel 6033:   white-space: pre;
                   6034: }
                   6035: 
1.525     albertel 6036: span.LC_prior_string {
1.925     bisitz   6037:   font-family: $mono;
1.525     albertel 6038:   white-space: pre;
                   6039: }
                   6040: 
1.523     albertel 6041: table.LC_prior_option {
                   6042:   width: 100%;
                   6043:   border-collapse: collapse;
                   6044: }
1.795     www      6045: 
1.911     bisitz   6046: table.LC_prior_rank,
1.795     www      6047: table.LC_prior_match {
1.528     albertel 6048:   border-collapse: collapse;
                   6049: }
1.795     www      6050: 
1.528     albertel 6051: table.LC_prior_option tr td,
                   6052: table.LC_prior_rank tr td,
                   6053: table.LC_prior_match tr td {
1.524     albertel 6054:   border: 1px solid #000000;
1.515     albertel 6055: }
                   6056: 
1.855     bisitz   6057: .LC_nobreak {
1.544     albertel 6058:   white-space: nowrap;
1.519     raeburn  6059: }
                   6060: 
1.576     raeburn  6061: span.LC_cusr_emph {
                   6062:   font-style: italic;
                   6063: }
                   6064: 
1.633     raeburn  6065: span.LC_cusr_subheading {
                   6066:   font-weight: normal;
                   6067:   font-size: 85%;
                   6068: }
                   6069: 
1.861     bisitz   6070: div.LC_docs_entry_move {
1.859     bisitz   6071:   border: 1px solid #BBBBBB;
1.545     albertel 6072:   background: #DDDDDD;
1.861     bisitz   6073:   width: 22px;
1.859     bisitz   6074:   padding: 1px;
                   6075:   margin: 0;
1.545     albertel 6076: }
                   6077: 
1.861     bisitz   6078: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6079: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6080:   background: #DDDDDD;
                   6081:   font-size: x-small;
                   6082: }
1.795     www      6083: 
1.861     bisitz   6084: .LC_docs_entry_parameter {
                   6085:   white-space: nowrap;
                   6086: }
                   6087: 
1.544     albertel 6088: .LC_docs_copy {
1.545     albertel 6089:   color: #000099;
1.544     albertel 6090: }
1.795     www      6091: 
1.544     albertel 6092: .LC_docs_cut {
1.545     albertel 6093:   color: #550044;
1.544     albertel 6094: }
1.795     www      6095: 
1.544     albertel 6096: .LC_docs_rename {
1.545     albertel 6097:   color: #009900;
1.544     albertel 6098: }
1.795     www      6099: 
1.544     albertel 6100: .LC_docs_remove {
1.545     albertel 6101:   color: #990000;
                   6102: }
                   6103: 
1.547     albertel 6104: .LC_docs_reinit_warn,
                   6105: .LC_docs_ext_edit {
                   6106:   font-size: x-small;
                   6107: }
                   6108: 
1.545     albertel 6109: table.LC_docs_adddocs td,
                   6110: table.LC_docs_adddocs th {
                   6111:   border: 1px solid #BBBBBB;
                   6112:   padding: 4px;
                   6113:   background: #DDDDDD;
1.543     albertel 6114: }
                   6115: 
1.584     albertel 6116: table.LC_sty_begin {
                   6117:   background: #BBFFBB;
                   6118: }
1.795     www      6119: 
1.584     albertel 6120: table.LC_sty_end {
                   6121:   background: #FFBBBB;
                   6122: }
                   6123: 
1.589     raeburn  6124: table.LC_double_column {
1.803     bisitz   6125:   border-width: 0;
1.589     raeburn  6126:   border-collapse: collapse;
                   6127:   width: 100%;
                   6128:   padding: 2px;
                   6129: }
                   6130: 
                   6131: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6132:   top: 2px;
1.589     raeburn  6133:   left: 2px;
                   6134:   width: 47%;
                   6135:   vertical-align: top;
                   6136: }
                   6137: 
                   6138: table.LC_double_column tr td.LC_right_col {
                   6139:   top: 2px;
1.779     bisitz   6140:   right: 2px;
1.589     raeburn  6141:   width: 47%;
                   6142:   vertical-align: top;
                   6143: }
                   6144: 
1.591     raeburn  6145: div.LC_left_float {
                   6146:   float: left;
                   6147:   padding-right: 5%;
1.597     albertel 6148:   padding-bottom: 4px;
1.591     raeburn  6149: }
                   6150: 
                   6151: div.LC_clear_float_header {
1.597     albertel 6152:   padding-bottom: 2px;
1.591     raeburn  6153: }
                   6154: 
                   6155: div.LC_clear_float_footer {
1.597     albertel 6156:   padding-top: 10px;
1.591     raeburn  6157:   clear: both;
                   6158: }
                   6159: 
1.597     albertel 6160: div.LC_grade_show_user {
1.941     bisitz   6161: /*  border-left: 5px solid $sidebg; */
                   6162:   border-top: 5px solid #000000;
                   6163:   margin: 50px 0 0 0;
1.936     bisitz   6164:   padding: 15px 0 5px 10px;
1.597     albertel 6165: }
1.795     www      6166: 
1.936     bisitz   6167: div.LC_grade_show_user_odd_row {
1.941     bisitz   6168: /*  border-left: 5px solid #000000; */
                   6169: }
                   6170: 
                   6171: div.LC_grade_show_user div.LC_Box {
                   6172:   margin-right: 50px;
1.597     albertel 6173: }
                   6174: 
                   6175: div.LC_grade_submissions,
                   6176: div.LC_grade_message_center,
1.936     bisitz   6177: div.LC_grade_info_links {
1.597     albertel 6178:   margin: 5px;
                   6179:   width: 99%;
                   6180:   background: #FFFFFF;
                   6181: }
1.795     www      6182: 
1.597     albertel 6183: div.LC_grade_submissions_header,
1.936     bisitz   6184: div.LC_grade_message_center_header {
1.705     tempelho 6185:   font-weight: bold;
                   6186:   font-size: large;
1.597     albertel 6187: }
1.795     www      6188: 
1.597     albertel 6189: div.LC_grade_submissions_body,
1.936     bisitz   6190: div.LC_grade_message_center_body {
1.597     albertel 6191:   border: 1px solid black;
                   6192:   width: 99%;
                   6193:   background: #FFFFFF;
                   6194: }
1.795     www      6195: 
1.613     albertel 6196: table.LC_scantron_action {
                   6197:   width: 100%;
                   6198: }
1.795     www      6199: 
1.613     albertel 6200: table.LC_scantron_action tr th {
1.698     harmsja  6201:   font-weight:bold;
                   6202:   font-style:normal;
1.613     albertel 6203: }
1.795     www      6204: 
1.779     bisitz   6205: .LC_edit_problem_header,
1.614     albertel 6206: div.LC_edit_problem_footer {
1.705     tempelho 6207:   font-weight: normal;
                   6208:   font-size:  medium;
1.602     albertel 6209:   margin: 2px;
1.1060    bisitz   6210:   background-color: $sidebg;
1.600     albertel 6211: }
1.795     www      6212: 
1.600     albertel 6213: div.LC_edit_problem_header,
1.602     albertel 6214: div.LC_edit_problem_header div,
1.614     albertel 6215: div.LC_edit_problem_footer,
                   6216: div.LC_edit_problem_footer div,
1.602     albertel 6217: div.LC_edit_problem_editxml_header,
                   6218: div.LC_edit_problem_editxml_header div {
1.600     albertel 6219:   margin-top: 5px;
                   6220: }
1.795     www      6221: 
1.600     albertel 6222: div.LC_edit_problem_header_title {
1.705     tempelho 6223:   font-weight: bold;
                   6224:   font-size: larger;
1.602     albertel 6225:   background: $tabbg;
                   6226:   padding: 3px;
1.1060    bisitz   6227:   margin: 0 0 5px 0;
1.602     albertel 6228: }
1.795     www      6229: 
1.602     albertel 6230: table.LC_edit_problem_header_title {
                   6231:   width: 100%;
1.600     albertel 6232:   background: $tabbg;
1.602     albertel 6233: }
                   6234: 
                   6235: div.LC_edit_problem_discards {
                   6236:   float: left;
                   6237:   padding-bottom: 5px;
                   6238: }
1.795     www      6239: 
1.602     albertel 6240: div.LC_edit_problem_saves {
                   6241:   float: right;
                   6242:   padding-bottom: 5px;
1.600     albertel 6243: }
1.795     www      6244: 
1.911     bisitz   6245: img.stift {
1.803     bisitz   6246:   border-width: 0;
                   6247:   vertical-align: middle;
1.677     riegler  6248: }
1.680     riegler  6249: 
1.923     bisitz   6250: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6251:   vertical-align: top;
1.777     tempelho 6252: }
1.795     www      6253: 
1.716     raeburn  6254: div.LC_createcourse {
1.911     bisitz   6255:   margin: 10px 10px 10px 10px;
1.716     raeburn  6256: }
                   6257: 
1.917     raeburn  6258: .LC_dccid {
                   6259:   margin: 0.2em 0 0 0;
                   6260:   padding: 0;
                   6261:   font-size: 90%;
                   6262:   display:none;
                   6263: }
                   6264: 
1.897     wenzelju 6265: ol.LC_primary_menu a:hover,
1.721     harmsja  6266: ol#LC_MenuBreadcrumbs a:hover,
                   6267: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6268: ul#LC_secondary_menu a:hover,
1.721     harmsja  6269: .LC_FormSectionClearButton input:hover
1.795     www      6270: ul.LC_TabContent   li:hover a {
1.952     onken    6271:   color:$button_hover;
1.911     bisitz   6272:   text-decoration:none;
1.693     droeschl 6273: }
                   6274: 
1.779     bisitz   6275: h1 {
1.911     bisitz   6276:   padding: 0;
                   6277:   line-height:130%;
1.693     droeschl 6278: }
1.698     harmsja  6279: 
1.911     bisitz   6280: h2,
                   6281: h3,
                   6282: h4,
                   6283: h5,
                   6284: h6 {
                   6285:   margin: 5px 0 5px 0;
                   6286:   padding: 0;
                   6287:   line-height:130%;
1.693     droeschl 6288: }
1.795     www      6289: 
                   6290: .LC_hcell {
1.911     bisitz   6291:   padding:3px 15px 3px 15px;
                   6292:   margin: 0;
                   6293:   background-color:$tabbg;
                   6294:   color:$fontmenu;
                   6295:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6296: }
1.795     www      6297: 
1.840     bisitz   6298: .LC_Box > .LC_hcell {
1.911     bisitz   6299:   margin: 0 -10px 10px -10px;
1.835     bisitz   6300: }
                   6301: 
1.721     harmsja  6302: .LC_noBorder {
1.911     bisitz   6303:   border: 0;
1.698     harmsja  6304: }
1.693     droeschl 6305: 
1.721     harmsja  6306: .LC_FormSectionClearButton input {
1.911     bisitz   6307:   background-color:transparent;
                   6308:   border: none;
                   6309:   cursor:pointer;
                   6310:   text-decoration:underline;
1.693     droeschl 6311: }
1.763     bisitz   6312: 
                   6313: .LC_help_open_topic {
1.911     bisitz   6314:   color: #FFFFFF;
                   6315:   background-color: #EEEEFF;
                   6316:   margin: 1px;
                   6317:   padding: 4px;
                   6318:   border: 1px solid #000033;
                   6319:   white-space: nowrap;
                   6320:   /* vertical-align: middle; */
1.759     neumanie 6321: }
1.693     droeschl 6322: 
1.911     bisitz   6323: dl,
                   6324: ul,
                   6325: div,
                   6326: fieldset {
                   6327:   margin: 10px 10px 10px 0;
                   6328:   /* overflow: hidden; */
1.693     droeschl 6329: }
1.795     www      6330: 
1.838     bisitz   6331: fieldset > legend {
1.911     bisitz   6332:   font-weight: bold;
                   6333:   padding: 0 5px 0 5px;
1.838     bisitz   6334: }
                   6335: 
1.813     bisitz   6336: #LC_nav_bar {
1.911     bisitz   6337:   float: left;
1.995     raeburn  6338:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6339:   margin: 0 0 2px 0;
1.807     droeschl 6340: }
                   6341: 
1.916     droeschl 6342: #LC_realm {
                   6343:   margin: 0.2em 0 0 0;
                   6344:   padding: 0;
                   6345:   font-weight: bold;
                   6346:   text-align: center;
1.995     raeburn  6347:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6348: }
                   6349: 
1.911     bisitz   6350: #LC_nav_bar em {
                   6351:   font-weight: bold;
                   6352:   font-style: normal;
1.807     droeschl 6353: }
                   6354: 
1.897     wenzelju 6355: ol.LC_primary_menu {
1.911     bisitz   6356:   float: right;
1.934     droeschl 6357:   margin: 0;
1.995     raeburn  6358:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6359: }
                   6360: 
1.852     droeschl 6361: ol#LC_PathBreadcrumbs {
1.911     bisitz   6362:   margin: 0;
1.693     droeschl 6363: }
                   6364: 
1.897     wenzelju 6365: ol.LC_primary_menu li {
1.911     bisitz   6366:   display: inline;
                   6367:   padding: 5px 5px 0 10px;
                   6368:   vertical-align: top;
1.693     droeschl 6369: }
                   6370: 
1.897     wenzelju 6371: ol.LC_primary_menu li img {
1.911     bisitz   6372:   vertical-align: bottom;
1.934     droeschl 6373:   height: 1.1em;
1.693     droeschl 6374: }
                   6375: 
1.897     wenzelju 6376: ol.LC_primary_menu a {
1.911     bisitz   6377:   color: RGB(80, 80, 80);
                   6378:   text-decoration: none;
1.693     droeschl 6379: }
1.795     www      6380: 
1.949     droeschl 6381: ol.LC_primary_menu a.LC_new_message {
                   6382:   font-weight:bold;
                   6383:   color: darkred;
                   6384: }
                   6385: 
1.975     raeburn  6386: ol.LC_docs_parameters {
                   6387:   margin-left: 0;
                   6388:   padding: 0;
                   6389:   list-style: none;
                   6390: }
                   6391: 
                   6392: ol.LC_docs_parameters li {
                   6393:   margin: 0;
                   6394:   padding-right: 20px;
                   6395:   display: inline;
                   6396: }
                   6397: 
1.976     raeburn  6398: ol.LC_docs_parameters li:before {
                   6399:   content: "\\002022 \\0020";
                   6400: }
                   6401: 
                   6402: li.LC_docs_parameters_title {
                   6403:   font-weight: bold;
                   6404: }
                   6405: 
                   6406: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6407:   content: "";
                   6408: }
                   6409: 
1.897     wenzelju 6410: ul#LC_secondary_menu {
1.911     bisitz   6411:   clear: both;
                   6412:   color: $fontmenu;
                   6413:   background: $tabbg;
                   6414:   list-style: none;
                   6415:   padding: 0;
                   6416:   margin: 0;
                   6417:   width: 100%;
1.995     raeburn  6418:   text-align: left;
1.808     droeschl 6419: }
                   6420: 
1.897     wenzelju 6421: ul#LC_secondary_menu li {
1.911     bisitz   6422:   font-weight: bold;
                   6423:   line-height: 1.8em;
                   6424:   padding: 0 0.8em;
                   6425:   border-right: 1px solid black;
                   6426:   display: inline;
                   6427:   vertical-align: middle;
1.807     droeschl 6428: }
                   6429: 
1.847     tempelho 6430: ul.LC_TabContent {
1.911     bisitz   6431:   display:block;
                   6432:   background: $sidebg;
                   6433:   border-bottom: solid 1px $lg_border_color;
                   6434:   list-style:none;
1.1020    raeburn  6435:   margin: -1px -10px 0 -10px;
1.911     bisitz   6436:   padding: 0;
1.693     droeschl 6437: }
                   6438: 
1.795     www      6439: ul.LC_TabContent li,
                   6440: ul.LC_TabContentBigger li {
1.911     bisitz   6441:   float:left;
1.741     harmsja  6442: }
1.795     www      6443: 
1.897     wenzelju 6444: ul#LC_secondary_menu li a {
1.911     bisitz   6445:   color: $fontmenu;
                   6446:   text-decoration: none;
1.693     droeschl 6447: }
1.795     www      6448: 
1.721     harmsja  6449: ul.LC_TabContent {
1.952     onken    6450:   min-height:20px;
1.721     harmsja  6451: }
1.795     www      6452: 
                   6453: ul.LC_TabContent li {
1.911     bisitz   6454:   vertical-align:middle;
1.959     onken    6455:   padding: 0 16px 0 10px;
1.911     bisitz   6456:   background-color:$tabbg;
                   6457:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6458:   border-left: solid 1px $font;
1.721     harmsja  6459: }
1.795     www      6460: 
1.847     tempelho 6461: ul.LC_TabContent .right {
1.911     bisitz   6462:   float:right;
1.847     tempelho 6463: }
                   6464: 
1.911     bisitz   6465: ul.LC_TabContent li a,
                   6466: ul.LC_TabContent li {
                   6467:   color:rgb(47,47,47);
                   6468:   text-decoration:none;
                   6469:   font-size:95%;
                   6470:   font-weight:bold;
1.952     onken    6471:   min-height:20px;
                   6472: }
                   6473: 
1.959     onken    6474: ul.LC_TabContent li a:hover,
                   6475: ul.LC_TabContent li a:focus {
1.952     onken    6476:   color: $button_hover;
1.959     onken    6477:   background:none;
                   6478:   outline:none;
1.952     onken    6479: }
                   6480: 
                   6481: ul.LC_TabContent li:hover {
                   6482:   color: $button_hover;
                   6483:   cursor:pointer;
1.721     harmsja  6484: }
1.795     www      6485: 
1.911     bisitz   6486: ul.LC_TabContent li.active {
1.952     onken    6487:   color: $font;
1.911     bisitz   6488:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6489:   border-bottom:solid 1px #FFFFFF;
                   6490:   cursor: default;
1.744     ehlerst  6491: }
1.795     www      6492: 
1.959     onken    6493: ul.LC_TabContent li.active a {
                   6494:   color:$font;
                   6495:   background:#FFFFFF;
                   6496:   outline: none;
                   6497: }
1.1047    raeburn  6498: 
                   6499: ul.LC_TabContent li.goback {
                   6500:   float: left;
                   6501:   border-left: none;
                   6502: }
                   6503: 
1.870     tempelho 6504: #maincoursedoc {
1.911     bisitz   6505:   clear:both;
1.870     tempelho 6506: }
                   6507: 
                   6508: ul.LC_TabContentBigger {
1.911     bisitz   6509:   display:block;
                   6510:   list-style:none;
                   6511:   padding: 0;
1.870     tempelho 6512: }
                   6513: 
1.795     www      6514: ul.LC_TabContentBigger li {
1.911     bisitz   6515:   vertical-align:bottom;
                   6516:   height: 30px;
                   6517:   font-size:110%;
                   6518:   font-weight:bold;
                   6519:   color: #737373;
1.841     tempelho 6520: }
                   6521: 
1.957     onken    6522: ul.LC_TabContentBigger li.active {
                   6523:   position: relative;
                   6524:   top: 1px;
                   6525: }
                   6526: 
1.870     tempelho 6527: ul.LC_TabContentBigger li a {
1.911     bisitz   6528:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6529:   height: 30px;
                   6530:   line-height: 30px;
                   6531:   text-align: center;
                   6532:   display: block;
                   6533:   text-decoration: none;
1.958     onken    6534:   outline: none;  
1.741     harmsja  6535: }
1.795     www      6536: 
1.870     tempelho 6537: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6538:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6539:   color:$font;
1.744     ehlerst  6540: }
1.795     www      6541: 
1.870     tempelho 6542: ul.LC_TabContentBigger li b {
1.911     bisitz   6543:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6544:   display: block;
                   6545:   float: left;
                   6546:   padding: 0 30px;
1.957     onken    6547:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6548: }
                   6549: 
1.956     onken    6550: ul.LC_TabContentBigger li:hover b {
                   6551:   color:$button_hover;
                   6552: }
                   6553: 
1.870     tempelho 6554: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6555:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6556:   color:$font;
1.957     onken    6557:   border: 0;
1.741     harmsja  6558: }
1.693     droeschl 6559: 
1.870     tempelho 6560: 
1.862     bisitz   6561: ul.LC_CourseBreadcrumbs {
                   6562:   background: $sidebg;
1.1020    raeburn  6563:   height: 2em;
1.862     bisitz   6564:   padding-left: 10px;
1.1020    raeburn  6565:   margin: 0;
1.862     bisitz   6566:   list-style-position: inside;
                   6567: }
                   6568: 
1.911     bisitz   6569: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6570: ol#LC_PathBreadcrumbs {
1.911     bisitz   6571:   padding-left: 10px;
                   6572:   margin: 0;
1.933     droeschl 6573:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6574: }
                   6575: 
1.911     bisitz   6576: ol#LC_MenuBreadcrumbs li,
                   6577: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6578: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6579:   display: inline;
1.933     droeschl 6580:   white-space: normal;  
1.693     droeschl 6581: }
                   6582: 
1.823     bisitz   6583: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6584: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6585:   text-decoration: none;
                   6586:   font-size:90%;
1.693     droeschl 6587: }
1.795     www      6588: 
1.969     droeschl 6589: ol#LC_MenuBreadcrumbs h1 {
                   6590:   display: inline;
                   6591:   font-size: 90%;
                   6592:   line-height: 2.5em;
                   6593:   margin: 0;
                   6594:   padding: 0;
                   6595: }
                   6596: 
1.795     www      6597: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6598:   text-decoration:none;
                   6599:   font-size:100%;
                   6600:   font-weight:bold;
1.693     droeschl 6601: }
1.795     www      6602: 
1.840     bisitz   6603: .LC_Box {
1.911     bisitz   6604:   border: solid 1px $lg_border_color;
                   6605:   padding: 0 10px 10px 10px;
1.746     neumanie 6606: }
1.795     www      6607: 
1.1020    raeburn  6608: .LC_DocsBox {
                   6609:   border: solid 1px $lg_border_color;
                   6610:   padding: 0 0 10px 10px;
                   6611: }
                   6612: 
1.795     www      6613: .LC_AboutMe_Image {
1.911     bisitz   6614:   float:left;
                   6615:   margin-right:10px;
1.747     neumanie 6616: }
1.795     www      6617: 
                   6618: .LC_Clear_AboutMe_Image {
1.911     bisitz   6619:   clear:left;
1.747     neumanie 6620: }
1.795     www      6621: 
1.721     harmsja  6622: dl.LC_ListStyleClean dt {
1.911     bisitz   6623:   padding-right: 5px;
                   6624:   display: table-header-group;
1.693     droeschl 6625: }
                   6626: 
1.721     harmsja  6627: dl.LC_ListStyleClean dd {
1.911     bisitz   6628:   display: table-row;
1.693     droeschl 6629: }
                   6630: 
1.721     harmsja  6631: .LC_ListStyleClean,
                   6632: .LC_ListStyleSimple,
                   6633: .LC_ListStyleNormal,
1.795     www      6634: .LC_ListStyleSpecial {
1.911     bisitz   6635:   /* display:block; */
                   6636:   list-style-position: inside;
                   6637:   list-style-type: none;
                   6638:   overflow: hidden;
                   6639:   padding: 0;
1.693     droeschl 6640: }
                   6641: 
1.721     harmsja  6642: .LC_ListStyleSimple li,
                   6643: .LC_ListStyleSimple dd,
                   6644: .LC_ListStyleNormal li,
                   6645: .LC_ListStyleNormal dd,
                   6646: .LC_ListStyleSpecial li,
1.795     www      6647: .LC_ListStyleSpecial dd {
1.911     bisitz   6648:   margin: 0;
                   6649:   padding: 5px 5px 5px 10px;
                   6650:   clear: both;
1.693     droeschl 6651: }
                   6652: 
1.721     harmsja  6653: .LC_ListStyleClean li,
                   6654: .LC_ListStyleClean dd {
1.911     bisitz   6655:   padding-top: 0;
                   6656:   padding-bottom: 0;
1.693     droeschl 6657: }
                   6658: 
1.721     harmsja  6659: .LC_ListStyleSimple dd,
1.795     www      6660: .LC_ListStyleSimple li {
1.911     bisitz   6661:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6662: }
                   6663: 
1.721     harmsja  6664: .LC_ListStyleSpecial li,
                   6665: .LC_ListStyleSpecial dd {
1.911     bisitz   6666:   list-style-type: none;
                   6667:   background-color: RGB(220, 220, 220);
                   6668:   margin-bottom: 4px;
1.693     droeschl 6669: }
                   6670: 
1.721     harmsja  6671: table.LC_SimpleTable {
1.911     bisitz   6672:   margin:5px;
                   6673:   border:solid 1px $lg_border_color;
1.795     www      6674: }
1.693     droeschl 6675: 
1.721     harmsja  6676: table.LC_SimpleTable tr {
1.911     bisitz   6677:   padding: 0;
                   6678:   border:solid 1px $lg_border_color;
1.693     droeschl 6679: }
1.795     www      6680: 
                   6681: table.LC_SimpleTable thead {
1.911     bisitz   6682:   background:rgb(220,220,220);
1.693     droeschl 6683: }
                   6684: 
1.721     harmsja  6685: div.LC_columnSection {
1.911     bisitz   6686:   display: block;
                   6687:   clear: both;
                   6688:   overflow: hidden;
                   6689:   margin: 0;
1.693     droeschl 6690: }
                   6691: 
1.721     harmsja  6692: div.LC_columnSection>* {
1.911     bisitz   6693:   float: left;
                   6694:   margin: 10px 20px 10px 0;
                   6695:   overflow:hidden;
1.693     droeschl 6696: }
1.721     harmsja  6697: 
1.795     www      6698: table em {
1.911     bisitz   6699:   font-weight: bold;
                   6700:   font-style: normal;
1.748     schulted 6701: }
1.795     www      6702: 
1.779     bisitz   6703: table.LC_tableBrowseRes,
1.795     www      6704: table.LC_tableOfContent {
1.911     bisitz   6705:   border:none;
                   6706:   border-spacing: 1px;
                   6707:   padding: 3px;
                   6708:   background-color: #FFFFFF;
                   6709:   font-size: 90%;
1.753     droeschl 6710: }
1.789     droeschl 6711: 
1.911     bisitz   6712: table.LC_tableOfContent {
                   6713:   border-collapse: collapse;
1.789     droeschl 6714: }
                   6715: 
1.771     droeschl 6716: table.LC_tableBrowseRes a,
1.768     schulted 6717: table.LC_tableOfContent a {
1.911     bisitz   6718:   background-color: transparent;
                   6719:   text-decoration: none;
1.753     droeschl 6720: }
                   6721: 
1.795     www      6722: table.LC_tableOfContent img {
1.911     bisitz   6723:   border: none;
                   6724:   height: 1.3em;
                   6725:   vertical-align: text-bottom;
                   6726:   margin-right: 0.3em;
1.753     droeschl 6727: }
1.757     schulted 6728: 
1.795     www      6729: a#LC_content_toolbar_firsthomework {
1.911     bisitz   6730:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  6731: }
                   6732: 
1.795     www      6733: a#LC_content_toolbar_everything {
1.911     bisitz   6734:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  6735: }
                   6736: 
1.795     www      6737: a#LC_content_toolbar_uncompleted {
1.911     bisitz   6738:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  6739: }
                   6740: 
1.795     www      6741: #LC_content_toolbar_clearbubbles {
1.911     bisitz   6742:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  6743: }
                   6744: 
1.795     www      6745: a#LC_content_toolbar_changefolder {
1.911     bisitz   6746:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 6747: }
                   6748: 
1.795     www      6749: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   6750:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 6751: }
                   6752: 
1.1043    raeburn  6753: a#LC_content_toolbar_edittoplevel {
                   6754:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   6755: }
                   6756: 
1.795     www      6757: ul#LC_toolbar li a:hover {
1.911     bisitz   6758:   background-position: bottom center;
1.757     schulted 6759: }
                   6760: 
1.795     www      6761: ul#LC_toolbar {
1.911     bisitz   6762:   padding: 0;
                   6763:   margin: 2px;
                   6764:   list-style:none;
                   6765:   position:relative;
                   6766:   background-color:white;
1.757     schulted 6767: }
                   6768: 
1.795     www      6769: ul#LC_toolbar li {
1.911     bisitz   6770:   border:1px solid white;
                   6771:   padding: 0;
                   6772:   margin: 0;
                   6773:   float: left;
                   6774:   display:inline;
                   6775:   vertical-align:middle;
                   6776: }
1.757     schulted 6777: 
1.783     amueller 6778: 
1.795     www      6779: a.LC_toolbarItem {
1.911     bisitz   6780:   display:block;
                   6781:   padding: 0;
                   6782:   margin: 0;
                   6783:   height: 32px;
                   6784:   width: 32px;
                   6785:   color:white;
                   6786:   border: none;
                   6787:   background-repeat:no-repeat;
                   6788:   background-color:transparent;
1.757     schulted 6789: }
                   6790: 
1.915     droeschl 6791: ul.LC_funclist {
                   6792:     margin: 0;
                   6793:     padding: 0.5em 1em 0.5em 0;
                   6794: }
                   6795: 
1.933     droeschl 6796: ul.LC_funclist > li:first-child {
                   6797:     font-weight:bold; 
                   6798:     margin-left:0.8em;
                   6799: }
                   6800: 
1.915     droeschl 6801: ul.LC_funclist + ul.LC_funclist {
                   6802:     /* 
                   6803:        left border as a seperator if we have more than
                   6804:        one list 
                   6805:     */
                   6806:     border-left: 1px solid $sidebg;
                   6807:     /* 
                   6808:        this hides the left border behind the border of the 
                   6809:        outer box if element is wrapped to the next 'line' 
                   6810:     */
                   6811:     margin-left: -1px;
                   6812: }
                   6813: 
1.843     bisitz   6814: ul.LC_funclist li {
1.915     droeschl 6815:   display: inline;
1.782     bisitz   6816:   white-space: nowrap;
1.915     droeschl 6817:   margin: 0 0 0 25px;
                   6818:   line-height: 150%;
1.782     bisitz   6819: }
                   6820: 
1.974     wenzelju 6821: .LC_hidden {
                   6822:   display: none;
                   6823: }
                   6824: 
1.1030    www      6825: .LCmodal-overlay {
                   6826: 		position:fixed;
                   6827: 		top:0;
                   6828: 		right:0;
                   6829: 		bottom:0;
                   6830: 		left:0;
                   6831: 		height:100%;
                   6832: 		width:100%;
                   6833: 		margin:0;
                   6834: 		padding:0;
                   6835: 		background:#999;
                   6836: 		opacity:.75;
                   6837: 		filter: alpha(opacity=75);
                   6838: 		-moz-opacity: 0.75;
                   6839: 		z-index:101;
                   6840: }
                   6841: 
                   6842: * html .LCmodal-overlay {   
                   6843: 		position: absolute;
                   6844: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   6845: }
                   6846: 
                   6847: .LCmodal-window {
                   6848: 		position:fixed;
                   6849: 		top:50%;
                   6850: 		left:50%;
                   6851: 		margin:0;
                   6852: 		padding:0;
                   6853: 		z-index:102;
                   6854: 	}
                   6855: 
                   6856: * html .LCmodal-window {
                   6857: 		position:absolute;
                   6858: }
                   6859: 
                   6860: .LCclose-window {
                   6861: 		position:absolute;
                   6862: 		width:32px;
                   6863: 		height:32px;
                   6864: 		right:8px;
                   6865: 		top:8px;
                   6866: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   6867: 		text-indent:-99999px;
                   6868: 		overflow:hidden;
                   6869: 		cursor:pointer;
                   6870: }
                   6871: 
1.343     albertel 6872: END
                   6873: }
                   6874: 
1.306     albertel 6875: =pod
                   6876: 
                   6877: =item * &headtag()
                   6878: 
                   6879: Returns a uniform footer for LON-CAPA web pages.
                   6880: 
1.307     albertel 6881: Inputs: $title - optional title for the head
                   6882:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 6883:         $args - optional arguments
1.319     albertel 6884:             force_register - if is true call registerurl so the remote is 
                   6885:                              informed
1.415     albertel 6886:             redirect       -> array ref of
                   6887:                                    1- seconds before redirect occurs
                   6888:                                    2- url to redirect to
                   6889:                                    3- whether the side effect should occur
1.315     albertel 6890:                            (side effect of setting 
                   6891:                                $env{'internal.head.redirect'} to the url 
                   6892:                                redirected too)
1.352     albertel 6893:             domain         -> force to color decorate a page for a specific
                   6894:                                domain
                   6895:             function       -> force usage of a specific rolish color scheme
                   6896:             bgcolor        -> override the default page bgcolor
1.460     albertel 6897:             no_auto_mt_title
                   6898:                            -> prevent &mt()ing the title arg
1.464     albertel 6899: 
1.306     albertel 6900: =cut
                   6901: 
                   6902: sub headtag {
1.313     albertel 6903:     my ($title,$head_extra,$args) = @_;
1.306     albertel 6904:     
1.363     albertel 6905:     my $function = $args->{'function'} || &get_users_function();
                   6906:     my $domain   = $args->{'domain'}   || &determinedomain();
                   6907:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 6908:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 6909: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 6910: 		   #time(),
1.418     albertel 6911: 		   $env{'environment.color.timestamp'},
1.363     albertel 6912: 		   $function,$domain,$bgcolor);
                   6913: 
1.369     www      6914:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 6915: 
1.308     albertel 6916:     my $result =
                   6917: 	'<head>'.
1.461     albertel 6918: 	&font_settings();
1.319     albertel 6919: 
1.1064    raeburn  6920:     my $inhibitprint = &print_suppression();
                   6921: 
1.461     albertel 6922:     if (!$args->{'frameset'}) {
                   6923: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   6924:     }
1.962     droeschl 6925:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   6926:         $result .= Apache::lonxml::display_title();
1.319     albertel 6927:     }
1.436     albertel 6928:     if (!$args->{'no_nav_bar'} 
                   6929: 	&& !$args->{'only_body'}
                   6930: 	&& !$args->{'frameset'}) {
                   6931: 	$result .= &help_menu_js();
1.1032    www      6932:         $result.=&modal_window();
1.1038    www      6933:         $result.=&togglebox_script();
1.1034    www      6934:         $result.=&wishlist_window();
1.1041    www      6935:         $result.=&LCprogressbarUpdate_script();
1.1034    www      6936:     } else {
                   6937:         if ($args->{'add_modal'}) {
                   6938:            $result.=&modal_window();
                   6939:         }
                   6940:         if ($args->{'add_wishlist'}) {
                   6941:            $result.=&wishlist_window();
                   6942:         }
1.1038    www      6943:         if ($args->{'add_togglebox'}) {
                   6944:            $result.=&togglebox_script();
                   6945:         }
1.1041    www      6946:         if ($args->{'add_progressbar'}) {
                   6947:            $result.=&LCprogressbarUpdate_script();
                   6948:         }
1.436     albertel 6949:     }
1.314     albertel 6950:     if (ref($args->{'redirect'})) {
1.414     albertel 6951: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 6952: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 6953: 	if (!$inhibit_continue) {
                   6954: 	    $env{'internal.head.redirect'} = $url;
                   6955: 	}
1.313     albertel 6956: 	$result.=<<ADDMETA
                   6957: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 6958: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 6959: ADDMETA
                   6960:     }
1.306     albertel 6961:     if (!defined($title)) {
                   6962: 	$title = 'The LearningOnline Network with CAPA';
                   6963:     }
1.460     albertel 6964:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   6965:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 6966: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064    raeburn  6967:         .$inhibitprint
1.414     albertel 6968: 	.$head_extra;
1.962     droeschl 6969:     return $result.'</head>';
1.306     albertel 6970: }
                   6971: 
                   6972: =pod
                   6973: 
1.340     albertel 6974: =item * &font_settings()
                   6975: 
                   6976: Returns neccessary <meta> to set the proper encoding
                   6977: 
                   6978: Inputs: none
                   6979: 
                   6980: =cut
                   6981: 
                   6982: sub font_settings {
                   6983:     my $headerstring='';
1.647     www      6984:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 6985: 	$headerstring.=
                   6986: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   6987:     }
                   6988:     return $headerstring;
                   6989: }
                   6990: 
1.341     albertel 6991: =pod
                   6992: 
1.1064    raeburn  6993: =item * &print_suppression()
                   6994: 
                   6995: In course context returns css which causes the body to be blank when media="print",
                   6996: if printout generation is unavailable for the current resource.
                   6997: 
                   6998: This could be because:
                   6999: 
                   7000: (a) printstartdate is in the future
                   7001: 
                   7002: (b) printenddate is in the past
                   7003: 
                   7004: (c) there is an active exam block with "printout"
                   7005: functionality blocked
                   7006: 
                   7007: Users with pav, pfo or evb privileges are exempt.
                   7008: 
                   7009: Inputs: none
                   7010: 
                   7011: =cut
                   7012: 
                   7013: 
                   7014: sub print_suppression {
                   7015:     my $noprint;
                   7016:     if ($env{'request.course.id'}) {
                   7017:         my $scope = $env{'request.course.id'};
                   7018:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7019:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7020:             return;
                   7021:         }
                   7022:         if ($env{'request.course.sec'} ne '') {
                   7023:             $scope .= "/$env{'request.course.sec'}";
                   7024:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7025:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7026:                 return;
1.1064    raeburn  7027:             }
                   7028:         }
                   7029:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7030:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7031:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7032:         if ($blocked) {
                   7033:             my $checkrole = "cm./$cdom/$cnum";
                   7034:             if ($env{'request.course.sec'} ne '') {
                   7035:                 $checkrole .= "/$env{'request.course.sec'}";
                   7036:             }
                   7037:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7038:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7039:                 $noprint = 1;
                   7040:             }
                   7041:         }
                   7042:         unless ($noprint) {
                   7043:             my $symb = &Apache::lonnet::symbread();
                   7044:             if ($symb ne '') {
                   7045:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7046:                 if (ref($navmap)) {
                   7047:                     my $res = $navmap->getBySymb($symb);
                   7048:                     if (ref($res)) {
                   7049:                         if (!$res->resprintable()) {
                   7050:                             $noprint = 1;
                   7051:                         }
                   7052:                     }
                   7053:                 }
                   7054:             }
                   7055:         }
                   7056:         if ($noprint) {
                   7057:             return <<"ENDSTYLE";
                   7058: <style type="text/css" media="print">
                   7059:     body { display:none }
                   7060: </style>
                   7061: ENDSTYLE
                   7062:         }
                   7063:     }
                   7064:     return;
                   7065: }
                   7066: 
                   7067: =pod
                   7068: 
1.341     albertel 7069: =item * &xml_begin()
                   7070: 
                   7071: Returns the needed doctype and <html>
                   7072: 
                   7073: Inputs: none
                   7074: 
                   7075: =cut
                   7076: 
                   7077: sub xml_begin {
                   7078:     my $output='';
                   7079: 
                   7080:     if ($env{'browser.mathml'}) {
                   7081: 	$output='<?xml version="1.0"?>'
                   7082:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7083: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7084:             
                   7085: #	    .'<!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">] >'
                   7086: 	    .'<!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">'
                   7087:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7088: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   7089:     } else {
1.849     bisitz   7090: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   7091:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 7092:     }
                   7093:     return $output;
                   7094: }
1.340     albertel 7095: 
                   7096: =pod
                   7097: 
1.306     albertel 7098: =item * &start_page()
                   7099: 
                   7100: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7101: 
1.648     raeburn  7102: Inputs:
                   7103: 
                   7104: =over 4
                   7105: 
                   7106: $title - optional title for the page
                   7107: 
                   7108: $head_extra - optional extra HTML to incude inside the <head>
                   7109: 
                   7110: $args - additional optional args supported are:
                   7111: 
                   7112: =over 8
                   7113: 
                   7114:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7115:                                     arg on
1.814     bisitz   7116:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7117:              add_entries    -> additional attributes to add to the  <body>
                   7118:              domain         -> force to color decorate a page for a 
1.317     albertel 7119:                                     specific domain
1.648     raeburn  7120:              function       -> force usage of a specific rolish color
1.317     albertel 7121:                                     scheme
1.648     raeburn  7122:              redirect       -> see &headtag()
                   7123:              bgcolor        -> override the default page bg color
                   7124:              js_ready       -> return a string ready for being used in 
1.317     albertel 7125:                                     a javascript writeln
1.648     raeburn  7126:              html_encode    -> return a string ready for being used in 
1.320     albertel 7127:                                     a html attribute
1.648     raeburn  7128:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7129:                                     $forcereg arg
1.648     raeburn  7130:              frameset       -> if true will start with a <frameset>
1.330     albertel 7131:                                     rather than <body>
1.648     raeburn  7132:              skip_phases    -> hash ref of 
1.338     albertel 7133:                                     head -> skip the <html><head> generation
                   7134:                                     body -> skip all <body> generation
1.648     raeburn  7135:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7136:              inherit_jsmath -> when creating popup window in a page,
                   7137:                                     should it have jsmath forced on by the
                   7138:                                     current page
1.867     kalberla 7139:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7140:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.361     albertel 7141: 
1.648     raeburn  7142: =back
1.460     albertel 7143: 
1.648     raeburn  7144: =back
1.562     albertel 7145: 
1.306     albertel 7146: =cut
                   7147: 
                   7148: sub start_page {
1.309     albertel 7149:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7150:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7151: 
1.315     albertel 7152:     $env{'internal.start_page'}++;
1.338     albertel 7153:     my $result;
1.964     droeschl 7154: 
1.338     albertel 7155:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      7156:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 7157:     }
                   7158:     
                   7159:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7160: 	if ($args->{'frameset'}) {
                   7161: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7162: 						$args->{'add_entries'});
                   7163: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7164:         } else {
                   7165:             $result .=
                   7166:                 &bodytag($title, 
                   7167:                          $args->{'function'},       $args->{'add_entries'},
                   7168:                          $args->{'only_body'},      $args->{'domain'},
                   7169:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.962     droeschl 7170:                          $args->{'bgcolor'},        $args);
1.831     bisitz   7171:         }
1.330     albertel 7172:     }
1.338     albertel 7173: 
1.315     albertel 7174:     if ($args->{'js_ready'}) {
1.713     kaisler  7175: 		$result = &js_ready($result);
1.315     albertel 7176:     }
1.320     albertel 7177:     if ($args->{'html_encode'}) {
1.713     kaisler  7178: 		$result = &html_encode($result);
                   7179:     }
                   7180: 
1.813     bisitz   7181:     # Preparation for new and consistent functionlist at top of screen
                   7182:     # if ($args->{'functionlist'}) {
                   7183:     #            $result .= &build_functionlist();
                   7184:     #}
                   7185: 
1.964     droeschl 7186:     # Don't add anything more if only_body wanted or in const space
                   7187:     return $result if    $args->{'only_body'} 
                   7188:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7189: 
                   7190:     #Breadcrumbs
1.758     kaisler  7191:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7192: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7193: 		#if any br links exists, add them to the breadcrumbs
                   7194: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7195: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7196: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7197: 			}
                   7198: 		}
                   7199: 
                   7200: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7201: 		if(exists($args->{'bread_crumbs_component'})){
                   7202: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7203: 		}else{
                   7204: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7205: 		}
1.320     albertel 7206:     }
1.315     albertel 7207:     return $result;
1.306     albertel 7208: }
                   7209: 
                   7210: sub end_page {
1.315     albertel 7211:     my ($args) = @_;
                   7212:     $env{'internal.end_page'}++;
1.330     albertel 7213:     my $result;
1.335     albertel 7214:     if ($args->{'discussion'}) {
                   7215: 	my ($target,$parser);
                   7216: 	if (ref($args->{'discussion'})) {
                   7217: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7218: 				$args->{'discussion'}{'parser'});
                   7219: 	}
                   7220: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7221:     }
1.330     albertel 7222:     if ($args->{'frameset'}) {
                   7223: 	$result .= '</frameset>';
                   7224:     } else {
1.635     raeburn  7225: 	$result .= &endbodytag($args);
1.330     albertel 7226:     }
                   7227:     $result .= "\n</html>";
                   7228: 
1.315     albertel 7229:     if ($args->{'js_ready'}) {
1.317     albertel 7230: 	$result = &js_ready($result);
1.315     albertel 7231:     }
1.335     albertel 7232: 
1.320     albertel 7233:     if ($args->{'html_encode'}) {
                   7234: 	$result = &html_encode($result);
                   7235:     }
1.335     albertel 7236: 
1.315     albertel 7237:     return $result;
                   7238: }
                   7239: 
1.1034    www      7240: sub wishlist_window {
                   7241:     return(<<'ENDWISHLIST');
1.1046    raeburn  7242: <script type="text/javascript">
1.1034    www      7243: // <![CDATA[
                   7244: // <!-- BEGIN LON-CAPA Internal
                   7245: function set_wishlistlink(title, path) {
                   7246:     if (!title) {
                   7247:         title = document.title;
                   7248:         title = title.replace(/^LON-CAPA /,'');
                   7249:     }
                   7250:     if (!path) {
                   7251:         path = location.pathname;
                   7252:     }
                   7253:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7254:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7255: }
                   7256: // END LON-CAPA Internal -->
                   7257: // ]]>
                   7258: </script>
                   7259: ENDWISHLIST
                   7260: }
                   7261: 
1.1030    www      7262: sub modal_window {
                   7263:     return(<<'ENDMODAL');
1.1046    raeburn  7264: <script type="text/javascript">
1.1030    www      7265: // <![CDATA[
                   7266: // <!-- BEGIN LON-CAPA Internal
                   7267: var modalWindow = {
                   7268: 	parent:"body",
                   7269: 	windowId:null,
                   7270: 	content:null,
                   7271: 	width:null,
                   7272: 	height:null,
                   7273: 	close:function()
                   7274: 	{
                   7275: 	        $(".LCmodal-window").remove();
                   7276: 	        $(".LCmodal-overlay").remove();
                   7277: 	},
                   7278: 	open:function()
                   7279: 	{
                   7280: 		var modal = "";
                   7281: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7282: 		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;\">";
                   7283: 		modal += this.content;
                   7284: 		modal += "</div>";	
                   7285: 
                   7286: 		$(this.parent).append(modal);
                   7287: 
                   7288: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7289: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7290: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7291: 	}
                   7292: };
1.1031    www      7293: 	var openMyModal = function(source,width,height,scrolling)
1.1030    www      7294: 	{
                   7295: 		modalWindow.windowId = "myModal";
                   7296: 		modalWindow.width = width;
                   7297: 		modalWindow.height = height;
1.1031    www      7298: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='true' src='" + source + "'>&lt/iframe>";
1.1030    www      7299: 		modalWindow.open();
                   7300: 	};	
                   7301: // END LON-CAPA Internal -->
                   7302: // ]]>
                   7303: </script>
                   7304: ENDMODAL
                   7305: }
                   7306: 
                   7307: sub modal_link {
1.1052    www      7308:     my ($link,$linktext,$width,$height,$target,$scrolling,$title)=@_;
1.1030    www      7309:     unless ($width) { $width=480; }
                   7310:     unless ($height) { $height=400; }
1.1031    www      7311:     unless ($scrolling) { $scrolling='yes'; }
1.1052    www      7312:     return '<a href="'.$link.'" target="'.$target.'" title="'.$title.'" onclick="openMyModal(\''.$link.'\','.$width.','.$height.',\''.$scrolling.'\'); return false;">'.
1.1031    www      7313:            $linktext.'</a>';
1.1030    www      7314: }
                   7315: 
1.1032    www      7316: sub modal_adhoc_script {
                   7317:     my ($funcname,$width,$height,$content)=@_;
                   7318:     return (<<ENDADHOC);
1.1046    raeburn  7319: <script type="text/javascript">
1.1032    www      7320: // <![CDATA[
                   7321:         var $funcname = function()
                   7322:         {
                   7323:                 modalWindow.windowId = "myModal";
                   7324:                 modalWindow.width = $width;
                   7325:                 modalWindow.height = $height;
                   7326:                 modalWindow.content = '$content';
                   7327:                 modalWindow.open();
                   7328:         };  
                   7329: // ]]>
                   7330: </script>
                   7331: ENDADHOC
                   7332: }
                   7333: 
1.1041    www      7334: sub modal_adhoc_inner {
                   7335:     my ($funcname,$width,$height,$content)=@_;
                   7336:     my $innerwidth=$width-20;
                   7337:     $content=&js_ready(
1.1042    www      7338:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1041    www      7339:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px').
                   7340:                     $content.
                   7341:                  &end_scrollbox().
                   7342:                &end_page()
                   7343:              );
                   7344:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7345: }
                   7346: 
                   7347: sub modal_adhoc_window {
                   7348:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7349:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7350:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7351: }
                   7352: 
                   7353: sub modal_adhoc_launch {
                   7354:     my ($funcname,$width,$height,$content)=@_;
                   7355:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7356: <script type="text/javascript">
                   7357: // <![CDATA[
                   7358: $funcname();
                   7359: // ]]>
                   7360: </script>
                   7361: ENDLAUNCH
                   7362: }
                   7363: 
                   7364: sub modal_adhoc_close {
                   7365:     return (<<ENDCLOSE);
                   7366: <script type="text/javascript">
                   7367: // <![CDATA[
                   7368: modalWindow.close();
                   7369: // ]]>
                   7370: </script>
                   7371: ENDCLOSE
                   7372: }
                   7373: 
1.1038    www      7374: sub togglebox_script {
                   7375:    return(<<ENDTOGGLE);
                   7376: <script type="text/javascript"> 
                   7377: // <![CDATA[
                   7378: function LCtoggleDisplay(id,hidetext,showtext) {
                   7379:    link = document.getElementById(id + "link").childNodes[0];
                   7380:    with (document.getElementById(id).style) {
                   7381:       if (display == "none" ) {
                   7382:           display = "inline";
                   7383:           link.nodeValue = hidetext;
                   7384:         } else {
                   7385:           display = "none";
                   7386:           link.nodeValue = showtext;
                   7387:        }
                   7388:    }
                   7389: }
                   7390: // ]]>
                   7391: </script>
                   7392: ENDTOGGLE
                   7393: }
                   7394: 
1.1039    www      7395: sub start_togglebox {
                   7396:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7397:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7398:     unless ($showtext) { $showtext=&mt('show'); }
                   7399:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7400:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7401:     return &start_data_table().
                   7402:            &start_data_table_header_row().
                   7403:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7404:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7405:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7406:            &end_data_table_header_row().
                   7407:            '<tr id="'.$id.'" style="display:none""><td>';
                   7408: }
                   7409: 
                   7410: sub end_togglebox {
                   7411:     return '</td></tr>'.&end_data_table();
                   7412: }
                   7413: 
1.1041    www      7414: sub LCprogressbar_script {
1.1045    www      7415:    my ($id)=@_;
1.1041    www      7416:    return(<<ENDPROGRESS);
                   7417: <script type="text/javascript">
                   7418: // <![CDATA[
1.1045    www      7419: \$('#progressbar$id').progressbar({
1.1041    www      7420:   value: 0,
                   7421:   change: function(event, ui) {
                   7422:     var newVal = \$(this).progressbar('option', 'value');
                   7423:     \$('.pblabel', this).text(LCprogressTxt);
                   7424:   }
                   7425: });
                   7426: // ]]>
                   7427: </script>
                   7428: ENDPROGRESS
                   7429: }
                   7430: 
                   7431: sub LCprogressbarUpdate_script {
                   7432:    return(<<ENDPROGRESSUPDATE);
                   7433: <style type="text/css">
                   7434: .ui-progressbar { position:relative; }
                   7435: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7436: </style>
                   7437: <script type="text/javascript">
                   7438: // <![CDATA[
1.1045    www      7439: var LCprogressTxt='---';
                   7440: 
                   7441: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7442:    LCprogressTxt=progresstext;
1.1045    www      7443:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7444: }
                   7445: // ]]>
                   7446: </script>
                   7447: ENDPROGRESSUPDATE
                   7448: }
                   7449: 
1.1042    www      7450: my $LClastpercent;
1.1045    www      7451: my $LCidcnt;
                   7452: my $LCcurrentid;
1.1042    www      7453: 
1.1041    www      7454: sub LCprogressbar {
1.1042    www      7455:     my ($r)=(@_);
                   7456:     $LClastpercent=0;
1.1045    www      7457:     $LCidcnt++;
                   7458:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7459:     my $starting=&mt('Starting');
                   7460:     my $content=(<<ENDPROGBAR);
                   7461: <p>
1.1045    www      7462:   <div id="progressbar$LCcurrentid">
1.1041    www      7463:     <span class="pblabel">$starting</span>
                   7464:   </div>
                   7465: </p>
                   7466: ENDPROGBAR
1.1045    www      7467:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7468: }
                   7469: 
                   7470: sub LCprogressbarUpdate {
1.1042    www      7471:     my ($r,$val,$text)=@_;
                   7472:     unless ($val) { 
                   7473:        if ($LClastpercent) {
                   7474:            $val=$LClastpercent;
                   7475:        } else {
                   7476:            $val=0;
                   7477:        }
                   7478:     }
1.1041    www      7479:     if ($val<0) { $val=0; }
                   7480:     if ($val>100) { $val=0; }
1.1042    www      7481:     $LClastpercent=$val;
1.1041    www      7482:     unless ($text) { $text=$val.'%'; }
                   7483:     $text=&js_ready($text);
1.1044    www      7484:     &r_print($r,<<ENDUPDATE);
1.1041    www      7485: <script type="text/javascript">
                   7486: // <![CDATA[
1.1045    www      7487: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7488: // ]]>
                   7489: </script>
                   7490: ENDUPDATE
1.1035    www      7491: }
                   7492: 
1.1042    www      7493: sub LCprogressbarClose {
                   7494:     my ($r)=@_;
                   7495:     $LClastpercent=0;
1.1044    www      7496:     &r_print($r,<<ENDCLOSE);
1.1042    www      7497: <script type="text/javascript">
                   7498: // <![CDATA[
1.1045    www      7499: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7500: // ]]>
                   7501: </script>
                   7502: ENDCLOSE
1.1044    www      7503: }
                   7504: 
                   7505: sub r_print {
                   7506:     my ($r,$to_print)=@_;
                   7507:     if ($r) {
                   7508:       $r->print($to_print);
                   7509:       $r->rflush();
                   7510:     } else {
                   7511:       print($to_print);
                   7512:     }
1.1042    www      7513: }
                   7514: 
1.320     albertel 7515: sub html_encode {
                   7516:     my ($result) = @_;
                   7517: 
1.322     albertel 7518:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7519:     
                   7520:     return $result;
                   7521: }
1.1044    www      7522: 
1.317     albertel 7523: sub js_ready {
                   7524:     my ($result) = @_;
                   7525: 
1.323     albertel 7526:     $result =~ s/[\n\r]/ /xmsg;
                   7527:     $result =~ s/\\/\\\\/xmsg;
                   7528:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7529:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7530:     
                   7531:     return $result;
                   7532: }
                   7533: 
1.315     albertel 7534: sub validate_page {
                   7535:     if (  exists($env{'internal.start_page'})
1.316     albertel 7536: 	  &&     $env{'internal.start_page'} > 1) {
                   7537: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7538: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7539: 				 $ENV{'request.filename'});
1.315     albertel 7540:     }
                   7541:     if (  exists($env{'internal.end_page'})
1.316     albertel 7542: 	  &&     $env{'internal.end_page'} > 1) {
                   7543: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7544: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7545: 				 $env{'request.filename'});
1.315     albertel 7546:     }
                   7547:     if (     exists($env{'internal.start_page'})
                   7548: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7549: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7550: 				 $env{'request.filename'});
1.315     albertel 7551:     }
                   7552:     if (   ! exists($env{'internal.start_page'})
                   7553: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7554: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7555: 				 $env{'request.filename'});
1.315     albertel 7556:     }
1.306     albertel 7557: }
1.315     albertel 7558: 
1.996     www      7559: 
                   7560: sub start_scrollbox {
1.1018    raeburn  7561:     my ($outerwidth,$width,$height,$id)=@_;
1.998     raeburn  7562:     unless ($outerwidth) { $outerwidth='520px'; }
                   7563:     unless ($width) { $width='500px'; }
                   7564:     unless ($height) { $height='200px'; }
1.1020    raeburn  7565:     my ($table_id,$div_id);
1.1018    raeburn  7566:     if ($id ne '') {
1.1020    raeburn  7567:         $table_id = " id='table_$id'";
                   7568:         $div_id = " id='div_$id'";
1.1018    raeburn  7569:     }
1.1020    raeburn  7570:     return "<table style='width: $outerwidth; border: 1px solid none;'$table_id><tr><td style='width: $width;' bgcolor='#FFFFFF'><div style='overflow:auto; width:$width; height: $height;'$div_id>";
1.996     www      7571: }
                   7572: 
                   7573: sub end_scrollbox {
1.1036    www      7574:     return '</div></td></tr></table>';
1.996     www      7575: }
                   7576: 
1.318     albertel 7577: sub simple_error_page {
                   7578:     my ($r,$title,$msg) = @_;
                   7579:     my $page =
                   7580: 	&Apache::loncommon::start_page($title).
                   7581: 	&mt($msg).
                   7582: 	&Apache::loncommon::end_page();
                   7583:     if (ref($r)) {
                   7584: 	$r->print($page);
1.327     albertel 7585: 	return;
1.318     albertel 7586:     }
                   7587:     return $page;
                   7588: }
1.347     albertel 7589: 
                   7590: {
1.610     albertel 7591:     my @row_count;
1.961     onken    7592: 
                   7593:     sub start_data_table_count {
                   7594:         unshift(@row_count, 0);
                   7595:         return;
                   7596:     }
                   7597: 
                   7598:     sub end_data_table_count {
                   7599:         shift(@row_count);
                   7600:         return;
                   7601:     }
                   7602: 
1.347     albertel 7603:     sub start_data_table {
1.1018    raeburn  7604: 	my ($add_class,$id) = @_;
1.422     albertel 7605: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  7606:         my $table_id;
                   7607:         if (defined($id)) {
                   7608:             $table_id = ' id="'.$id.'"';
                   7609:         }
1.961     onken    7610: 	&start_data_table_count();
1.1018    raeburn  7611: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 7612:     }
                   7613: 
                   7614:     sub end_data_table {
1.961     onken    7615: 	&end_data_table_count();
1.389     albertel 7616: 	return '</table>'."\n";;
1.347     albertel 7617:     }
                   7618: 
                   7619:     sub start_data_table_row {
1.974     wenzelju 7620: 	my ($add_class, $id) = @_;
1.610     albertel 7621: 	$row_count[0]++;
                   7622: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   7623: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 7624:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7625:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 7626:     }
1.471     banghart 7627:     
                   7628:     sub continue_data_table_row {
1.974     wenzelju 7629: 	my ($add_class, $id) = @_;
1.610     albertel 7630: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 7631: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   7632:         $id = (' id="'.$id.'"') unless ($id eq '');
                   7633:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 7634:     }
1.347     albertel 7635: 
                   7636:     sub end_data_table_row {
1.389     albertel 7637: 	return '</tr>'."\n";;
1.347     albertel 7638:     }
1.367     www      7639: 
1.421     albertel 7640:     sub start_data_table_empty_row {
1.707     bisitz   7641: #	$row_count[0]++;
1.421     albertel 7642: 	return  '<tr class="LC_empty_row" >'."\n";;
                   7643:     }
                   7644: 
                   7645:     sub end_data_table_empty_row {
                   7646: 	return '</tr>'."\n";;
                   7647:     }
                   7648: 
1.367     www      7649:     sub start_data_table_header_row {
1.389     albertel 7650: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      7651:     }
                   7652: 
                   7653:     sub end_data_table_header_row {
1.389     albertel 7654: 	return '</tr>'."\n";;
1.367     www      7655:     }
1.890     droeschl 7656: 
                   7657:     sub data_table_caption {
                   7658:         my $caption = shift;
                   7659:         return "<caption class=\"LC_caption\">$caption</caption>";
                   7660:     }
1.347     albertel 7661: }
                   7662: 
1.548     albertel 7663: =pod
                   7664: 
                   7665: =item * &inhibit_menu_check($arg)
                   7666: 
                   7667: Checks for a inhibitmenu state and generates output to preserve it
                   7668: 
                   7669: Inputs:         $arg - can be any of
                   7670:                      - undef - in which case the return value is a string 
                   7671:                                to add  into arguments list of a uri
                   7672:                      - 'input' - in which case the return value is a HTML
                   7673:                                  <form> <input> field of type hidden to
                   7674:                                  preserve the value
                   7675:                      - a url - in which case the return value is the url with
                   7676:                                the neccesary cgi args added to preserve the
                   7677:                                inhibitmenu state
                   7678:                      - a ref to a url - no return value, but the string is
                   7679:                                         updated to include the neccessary cgi
                   7680:                                         args to preserve the inhibitmenu state
                   7681: 
                   7682: =cut
                   7683: 
                   7684: sub inhibit_menu_check {
                   7685:     my ($arg) = @_;
                   7686:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   7687:     if ($arg eq 'input') {
                   7688: 	if ($env{'form.inhibitmenu'}) {
                   7689: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   7690: 	} else {
                   7691: 	    return
                   7692: 	}
                   7693:     }
                   7694:     if ($env{'form.inhibitmenu'}) {
                   7695: 	if (ref($arg)) {
                   7696: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7697: 	} elsif ($arg eq '') {
                   7698: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   7699: 	} else {
                   7700: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   7701: 	}
                   7702:     }
                   7703:     if (!ref($arg)) {
                   7704: 	return $arg;
                   7705:     }
                   7706: }
                   7707: 
1.251     albertel 7708: ###############################################
1.182     matthew  7709: 
                   7710: =pod
                   7711: 
1.549     albertel 7712: =back
                   7713: 
                   7714: =head1 User Information Routines
                   7715: 
                   7716: =over 4
                   7717: 
1.405     albertel 7718: =item * &get_users_function()
1.182     matthew  7719: 
                   7720: Used by &bodytag to determine the current users primary role.
                   7721: Returns either 'student','coordinator','admin', or 'author'.
                   7722: 
                   7723: =cut
                   7724: 
                   7725: ###############################################
                   7726: sub get_users_function {
1.815     tempelho 7727:     my $function = 'norole';
1.818     tempelho 7728:     if ($env{'request.role'}=~/^(st)/) {
                   7729:         $function='student';
                   7730:     }
1.907     raeburn  7731:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  7732:         $function='coordinator';
                   7733:     }
1.258     albertel 7734:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  7735:         $function='admin';
                   7736:     }
1.826     bisitz   7737:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  7738:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  7739:         $function='author';
                   7740:     }
                   7741:     return $function;
1.54      www      7742: }
1.99      www      7743: 
                   7744: ###############################################
                   7745: 
1.233     raeburn  7746: =pod
                   7747: 
1.821     raeburn  7748: =item * &show_course()
                   7749: 
                   7750: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   7751: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   7752: 
                   7753: Inputs:
                   7754: None
                   7755: 
                   7756: Outputs:
                   7757: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   7758: 
                   7759: =cut
                   7760: 
                   7761: ###############################################
                   7762: sub show_course {
                   7763:     my $course = !$env{'user.adv'};
                   7764:     if (!$env{'user.adv'}) {
                   7765:         foreach my $env (keys(%env)) {
                   7766:             next if ($env !~ m/^user\.priv\./);
                   7767:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   7768:                 $course = 0;
                   7769:                 last;
                   7770:             }
                   7771:         }
                   7772:     }
                   7773:     return $course;
                   7774: }
                   7775: 
                   7776: ###############################################
                   7777: 
                   7778: =pod
                   7779: 
1.542     raeburn  7780: =item * &check_user_status()
1.274     raeburn  7781: 
                   7782: Determines current status of supplied role for a
                   7783: specific user. Roles can be active, previous or future.
                   7784: 
                   7785: Inputs: 
                   7786: user's domain, user's username, course's domain,
1.375     raeburn  7787: course's number, optional section ID.
1.274     raeburn  7788: 
                   7789: Outputs:
                   7790: role status: active, previous or future. 
                   7791: 
                   7792: =cut
                   7793: 
                   7794: sub check_user_status {
1.412     raeburn  7795:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.982     raeburn  7796:     my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
                   7797:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname,'.',undef,$extra);
1.274     raeburn  7798:     my @uroles = keys %userinfo;
                   7799:     my $srchstr;
                   7800:     my $active_chk = 'none';
1.412     raeburn  7801:     my $now = time;
1.274     raeburn  7802:     if (@uroles > 0) {
1.908     raeburn  7803:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  7804:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   7805:         } else {
1.412     raeburn  7806:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   7807:         }
                   7808:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  7809:             my $role_end = 0;
                   7810:             my $role_start = 0;
                   7811:             $active_chk = 'active';
1.412     raeburn  7812:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   7813:                 $role_end = $1;
                   7814:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   7815:                     $role_start = $1;
1.274     raeburn  7816:                 }
                   7817:             }
                   7818:             if ($role_start > 0) {
1.412     raeburn  7819:                 if ($now < $role_start) {
1.274     raeburn  7820:                     $active_chk = 'future';
                   7821:                 }
                   7822:             }
                   7823:             if ($role_end > 0) {
1.412     raeburn  7824:                 if ($now > $role_end) {
1.274     raeburn  7825:                     $active_chk = 'previous';
                   7826:                 }
                   7827:             }
                   7828:         }
                   7829:     }
                   7830:     return $active_chk;
                   7831: }
                   7832: 
                   7833: ###############################################
                   7834: 
                   7835: =pod
                   7836: 
1.405     albertel 7837: =item * &get_sections()
1.233     raeburn  7838: 
                   7839: Determines all the sections for a course including
                   7840: sections with students and sections containing other roles.
1.419     raeburn  7841: Incoming parameters: 
                   7842: 
                   7843: 1. domain
                   7844: 2. course number 
                   7845: 3. reference to array containing roles for which sections should 
                   7846: be gathered (optional).
                   7847: 4. reference to array containing status types for which sections 
                   7848: should be gathered (optional).
                   7849: 
                   7850: If the third argument is undefined, sections are gathered for any role. 
                   7851: If the fourth argument is undefined, sections are gathered for any status.
                   7852: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  7853:  
1.374     raeburn  7854: Returns section hash (keys are section IDs, values are
                   7855: number of users in each section), subject to the
1.419     raeburn  7856: optional roles filter, optional status filter 
1.233     raeburn  7857: 
                   7858: =cut
                   7859: 
                   7860: ###############################################
                   7861: sub get_sections {
1.419     raeburn  7862:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 7863:     if (!defined($cdom) || !defined($cnum)) {
                   7864:         my $cid =  $env{'request.course.id'};
                   7865: 
                   7866: 	return if (!defined($cid));
                   7867: 
                   7868:         $cdom = $env{'course.'.$cid.'.domain'};
                   7869:         $cnum = $env{'course.'.$cid.'.num'};
                   7870:     }
                   7871: 
                   7872:     my %sectioncount;
1.419     raeburn  7873:     my $now = time;
1.240     albertel 7874: 
1.366     albertel 7875:     if (!defined($possible_roles) || (grep(/^st$/,@$possible_roles))) {
1.276     albertel 7876: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 7877: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   7878: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  7879:         my $start_index = &Apache::loncoursedata::CL_START();
                   7880:         my $end_index = &Apache::loncoursedata::CL_END();
                   7881:         my $status;
1.366     albertel 7882: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  7883: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   7884: 				                     $data->[$status_index],
                   7885:                                                      $data->[$start_index],
                   7886:                                                      $data->[$end_index]);
                   7887:             if ($stu_status eq 'Active') {
                   7888:                 $status = 'active';
                   7889:             } elsif ($end < $now) {
                   7890:                 $status = 'previous';
                   7891:             } elsif ($start > $now) {
                   7892:                 $status = 'future';
                   7893:             } 
                   7894: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   7895:                 if ((!defined($possible_status)) || (($status ne '') && 
                   7896:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   7897: 		    $sectioncount{$section}++;
                   7898:                 }
1.240     albertel 7899: 	    }
                   7900: 	}
                   7901:     }
                   7902:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   7903:     foreach my $user (sort(keys(%courseroles))) {
                   7904: 	if ($user !~ /^(\w{2})/) { next; }
                   7905: 	my ($role) = ($user =~ /^(\w{2})/);
                   7906: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  7907: 	my ($section,$status);
1.240     albertel 7908: 	if ($role eq 'cr' &&
                   7909: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   7910: 	    $section=$1;
                   7911: 	}
                   7912: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   7913: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  7914:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   7915:         if ($end == -1 && $start == -1) {
                   7916:             next; #deleted role
                   7917:         }
                   7918:         if (!defined($possible_status)) { 
                   7919:             $sectioncount{$section}++;
                   7920:         } else {
                   7921:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   7922:                 $status = 'active';
                   7923:             } elsif ($end < $now) {
                   7924:                 $status = 'future';
                   7925:             } elsif ($start > $now) {
                   7926:                 $status = 'previous';
                   7927:             }
                   7928:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   7929:                 $sectioncount{$section}++;
                   7930:             }
                   7931:         }
1.233     raeburn  7932:     }
1.366     albertel 7933:     return %sectioncount;
1.233     raeburn  7934: }
                   7935: 
1.274     raeburn  7936: ###############################################
1.294     raeburn  7937: 
                   7938: =pod
1.405     albertel 7939: 
                   7940: =item * &get_course_users()
                   7941: 
1.275     raeburn  7942: Retrieves usernames:domains for users in the specified course
                   7943: with specific role(s), and access status. 
                   7944: 
                   7945: Incoming parameters:
1.277     albertel 7946: 1. course domain
                   7947: 2. course number
                   7948: 3. access status: users must have - either active, 
1.275     raeburn  7949: previous, future, or all.
1.277     albertel 7950: 4. reference to array of permissible roles
1.288     raeburn  7951: 5. reference to array of section restrictions (optional)
                   7952: 6. reference to results object (hash of hashes).
                   7953: 7. reference to optional userdata hash
1.609     raeburn  7954: 8. reference to optional statushash
1.630     raeburn  7955: 9. flag if privileged users (except those set to unhide in
                   7956:    course settings) should be excluded    
1.609     raeburn  7957: Keys of top level results hash are roles.
1.275     raeburn  7958: Keys of inner hashes are username:domain, with 
                   7959: values set to access type.
1.288     raeburn  7960: Optional userdata hash returns an array with arguments in the 
                   7961: same order as loncoursedata::get_classlist() for student data.
                   7962: 
1.609     raeburn  7963: Optional statushash returns
                   7964: 
1.288     raeburn  7965: Entries for end, start, section and status are blank because
                   7966: of the possibility of multiple values for non-student roles.
                   7967: 
1.275     raeburn  7968: =cut
1.405     albertel 7969: 
1.275     raeburn  7970: ###############################################
1.405     albertel 7971: 
1.275     raeburn  7972: sub get_course_users {
1.630     raeburn  7973:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  7974:     my %idx = ();
1.419     raeburn  7975:     my %seclists;
1.288     raeburn  7976: 
                   7977:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   7978:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   7979:     $idx{end} = &Apache::loncoursedata::CL_END();
                   7980:     $idx{start} = &Apache::loncoursedata::CL_START();
                   7981:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   7982:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   7983:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   7984:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   7985: 
1.290     albertel 7986:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 7987:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  7988:         my $now = time;
1.277     albertel 7989:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  7990:             my $match = 0;
1.412     raeburn  7991:             my $secmatch = 0;
1.419     raeburn  7992:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  7993:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  7994:             if ($section eq '') {
                   7995:                 $section = 'none';
                   7996:             }
1.291     albertel 7997:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 7998:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  7999:                     $secmatch = 1;
                   8000:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8001:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8002:                         $secmatch = 1;
                   8003:                     }
                   8004:                 } else {  
1.419     raeburn  8005: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8006: 		        $secmatch = 1;
                   8007:                     }
1.290     albertel 8008: 		}
1.412     raeburn  8009:                 if (!$secmatch) {
                   8010:                     next;
                   8011:                 }
1.419     raeburn  8012:             }
1.275     raeburn  8013:             if (defined($$types{'active'})) {
1.288     raeburn  8014:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8015:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8016:                     $match = 1;
1.275     raeburn  8017:                 }
                   8018:             }
                   8019:             if (defined($$types{'previous'})) {
1.609     raeburn  8020:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8021:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8022:                     $match = 1;
1.275     raeburn  8023:                 }
                   8024:             }
                   8025:             if (defined($$types{'future'})) {
1.609     raeburn  8026:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8027:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8028:                     $match = 1;
1.275     raeburn  8029:                 }
                   8030:             }
1.609     raeburn  8031:             if ($match) {
                   8032:                 push(@{$seclists{$student}},$section);
                   8033:                 if (ref($userdata) eq 'HASH') {
                   8034:                     $$userdata{$student} = $$classlist{$student};
                   8035:                 }
                   8036:                 if (ref($statushash) eq 'HASH') {
                   8037:                     $statushash->{$student}{'st'}{$section} = $status;
                   8038:                 }
1.288     raeburn  8039:             }
1.275     raeburn  8040:         }
                   8041:     }
1.412     raeburn  8042:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8043:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8044:         my $now = time;
1.609     raeburn  8045:         my %displaystatus = ( previous => 'Expired',
                   8046:                               active   => 'Active',
                   8047:                               future   => 'Future',
                   8048:                             );
1.630     raeburn  8049:         my %nothide;
                   8050:         if ($hidepriv) {
                   8051:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8052:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8053:                 if ($user !~ /:/) {
                   8054:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8055:                 } else {
                   8056:                     $nothide{$user} = 1;
                   8057:                 }
                   8058:             }
                   8059:         }
1.439     raeburn  8060:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8061:             my $match = 0;
1.412     raeburn  8062:             my $secmatch = 0;
1.439     raeburn  8063:             my $status;
1.412     raeburn  8064:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8065:             $user =~ s/:$//;
1.439     raeburn  8066:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8067:             if ($end == -1 || $start == -1) {
                   8068:                 next;
                   8069:             }
                   8070:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8071:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8072:                 my ($uname,$udom) = split(/:/,$user);
                   8073:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8074:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8075:                         $secmatch = 1;
                   8076:                     } elsif ($usec eq '') {
1.420     albertel 8077:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8078:                             $secmatch = 1;
                   8079:                         }
                   8080:                     } else {
                   8081:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8082:                             $secmatch = 1;
                   8083:                         }
                   8084:                     }
                   8085:                     if (!$secmatch) {
                   8086:                         next;
                   8087:                     }
1.288     raeburn  8088:                 }
1.419     raeburn  8089:                 if ($usec eq '') {
                   8090:                     $usec = 'none';
                   8091:                 }
1.275     raeburn  8092:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8093:                     if ($hidepriv) {
                   8094:                         if ((&Apache::lonnet::privileged($uname,$udom)) &&
                   8095:                             (!$nothide{$uname.':'.$udom})) {
                   8096:                             next;
                   8097:                         }
                   8098:                     }
1.503     raeburn  8099:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8100:                         $status = 'previous';
                   8101:                     } elsif ($start > $now) {
                   8102:                         $status = 'future';
                   8103:                     } else {
                   8104:                         $status = 'active';
                   8105:                     }
1.277     albertel 8106:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8107:                         if ($status eq $type) {
1.420     albertel 8108:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8109:                                 push(@{$$users{$role}{$user}},$type);
                   8110:                             }
1.288     raeburn  8111:                             $match = 1;
                   8112:                         }
                   8113:                     }
1.419     raeburn  8114:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8115:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8116: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8117:                         }
1.420     albertel 8118:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8119:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8120:                         }
1.609     raeburn  8121:                         if (ref($statushash) eq 'HASH') {
                   8122:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8123:                         }
1.275     raeburn  8124:                     }
                   8125:                 }
                   8126:             }
                   8127:         }
1.290     albertel 8128:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8129:             if ((defined($cdom)) && (defined($cnum))) {
                   8130:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8131:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8132:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8133:                     next if ($owner eq '');
                   8134:                     my ($ownername,$ownerdom);
                   8135:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8136:                         $ownername = $1;
                   8137:                         $ownerdom = $2;
                   8138:                     } else {
                   8139:                         $ownername = $owner;
                   8140:                         $ownerdom = $cdom;
                   8141:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8142:                     }
                   8143:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8144:                     if (defined($userdata) && 
1.609     raeburn  8145: 			!exists($$userdata{$owner})) {
                   8146: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8147:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8148:                             push(@{$seclists{$owner}},'none');
                   8149:                         }
                   8150:                         if (ref($statushash) eq 'HASH') {
                   8151:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8152:                         }
1.290     albertel 8153: 		    }
1.279     raeburn  8154:                 }
                   8155:             }
                   8156:         }
1.419     raeburn  8157:         foreach my $user (keys(%seclists)) {
                   8158:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8159:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8160:         }
1.275     raeburn  8161:     }
                   8162:     return;
                   8163: }
                   8164: 
1.288     raeburn  8165: sub get_user_info {
                   8166:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8167:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8168: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8169:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8170:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8171:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8172:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8173:     return;
                   8174: }
1.275     raeburn  8175: 
1.472     raeburn  8176: ###############################################
                   8177: 
                   8178: =pod
                   8179: 
                   8180: =item * &get_user_quota()
                   8181: 
                   8182: Retrieves quota assigned for storage of portfolio files for a user  
                   8183: 
                   8184: Incoming parameters:
                   8185: 1. user's username
                   8186: 2. user's domain
                   8187: 
                   8188: Returns:
1.536     raeburn  8189: 1. Disk quota (in Mb) assigned to student.
                   8190: 2. (Optional) Type of setting: custom or default
                   8191:    (individually assigned or default for user's 
                   8192:    institutional status).
                   8193: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8194:    or student - types as defined in localenroll::inst_usertypes 
                   8195:    for user's domain, which determines default quota for user.
                   8196: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8197: 
                   8198: If a value has been stored in the user's environment, 
1.536     raeburn  8199: it will return that, otherwise it returns the maximal default
                   8200: defined for the user's instituional status(es) in the domain.
1.472     raeburn  8201: 
                   8202: =cut
                   8203: 
                   8204: ###############################################
                   8205: 
                   8206: 
                   8207: sub get_user_quota {
                   8208:     my ($uname,$udom) = @_;
1.536     raeburn  8209:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8210:     if (!defined($udom)) {
                   8211:         $udom = $env{'user.domain'};
                   8212:     }
                   8213:     if (!defined($uname)) {
                   8214:         $uname = $env{'user.name'};
                   8215:     }
                   8216:     if (($udom eq '' || $uname eq '') ||
                   8217:         ($udom eq 'public') && ($uname eq 'public')) {
                   8218:         $quota = 0;
1.536     raeburn  8219:         $quotatype = 'default';
                   8220:         $defquota = 0; 
1.472     raeburn  8221:     } else {
1.536     raeburn  8222:         my $inststatus;
1.472     raeburn  8223:         if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8224:             $quota = $env{'environment.portfolioquota'};
1.536     raeburn  8225:             $inststatus = $env{'environment.inststatus'};
1.472     raeburn  8226:         } else {
1.536     raeburn  8227:             my %userenv = 
                   8228:                 &Apache::lonnet::get('environment',['portfolioquota',
                   8229:                                      'inststatus'],$udom,$uname);
1.472     raeburn  8230:             my ($tmp) = keys(%userenv);
                   8231:             if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8232:                 $quota = $userenv{'portfolioquota'};
1.536     raeburn  8233:                 $inststatus = $userenv{'inststatus'};
1.472     raeburn  8234:             } else {
                   8235:                 undef(%userenv);
                   8236:             }
                   8237:         }
1.536     raeburn  8238:         ($defquota,$settingstatus) = &default_quota($udom,$inststatus);
1.472     raeburn  8239:         if ($quota eq '') {
1.536     raeburn  8240:             $quota = $defquota;
                   8241:             $quotatype = 'default';
                   8242:         } else {
                   8243:             $quotatype = 'custom';
1.472     raeburn  8244:         }
                   8245:     }
1.536     raeburn  8246:     if (wantarray) {
                   8247:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8248:     } else {
                   8249:         return $quota;
                   8250:     }
1.472     raeburn  8251: }
                   8252: 
                   8253: ###############################################
                   8254: 
                   8255: =pod
                   8256: 
                   8257: =item * &default_quota()
                   8258: 
1.536     raeburn  8259: Retrieves default quota assigned for storage of user portfolio files,
                   8260: given an (optional) user's institutional status.
1.472     raeburn  8261: 
                   8262: Incoming parameters:
                   8263: 1. domain
1.536     raeburn  8264: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8265:    status types (e.g., faculty, staff, student etc.)
                   8266:    which apply to the user for whom the default is being retrieved.
                   8267:    If the institutional status string in undefined, the domain
                   8268:    default quota will be returned. 
1.472     raeburn  8269: 
                   8270: Returns:
                   8271: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  8272: 2. (Optional) institutional type which determined the value of the
                   8273:    default quota.
1.472     raeburn  8274: 
                   8275: If a value has been stored in the domain's configuration db,
                   8276: it will return that, otherwise it returns 20 (for backwards 
                   8277: compatibility with domains which have not set up a configuration
                   8278: db file; the original statically defined portfolio quota was 20 Mb). 
                   8279: 
1.536     raeburn  8280: If the user's status includes multiple types (e.g., staff and student),
                   8281: the largest default quota which applies to the user determines the
                   8282: default quota returned.
                   8283: 
1.780     raeburn  8284: =back
                   8285: 
1.472     raeburn  8286: =cut
                   8287: 
                   8288: ###############################################
                   8289: 
                   8290: 
                   8291: sub default_quota {
1.536     raeburn  8292:     my ($udom,$inststatus) = @_;
                   8293:     my ($defquota,$settingstatus);
                   8294:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8295:                                             ['quotas'],$udom);
                   8296:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8297:         if ($inststatus ne '') {
1.765     raeburn  8298:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8299:             foreach my $item (@statuses) {
1.711     raeburn  8300:                 if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8301:                     if ($quotahash{'quotas'}{'defaultquota'}{$item} ne '') {
                   8302:                         if ($defquota eq '') {
                   8303:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8304:                             $settingstatus = $item;
                   8305:                         } elsif ($quotahash{'quotas'}{'defaultquota'}{$item} > $defquota) {
                   8306:                             $defquota = $quotahash{'quotas'}{'defaultquota'}{$item};
                   8307:                             $settingstatus = $item;
                   8308:                         }
                   8309:                     }
                   8310:                 } else {
                   8311:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8312:                         if ($defquota eq '') {
                   8313:                             $defquota = $quotahash{'quotas'}{$item};
                   8314:                             $settingstatus = $item;
                   8315:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8316:                             $defquota = $quotahash{'quotas'}{$item};
                   8317:                             $settingstatus = $item;
                   8318:                         }
1.536     raeburn  8319:                     }
                   8320:                 }
                   8321:             }
                   8322:         }
                   8323:         if ($defquota eq '') {
1.711     raeburn  8324:             if (ref($quotahash{'quotas'}{'defaultquota'}) eq 'HASH') {
                   8325:                 $defquota = $quotahash{'quotas'}{'defaultquota'}{'default'};
                   8326:             } else {
                   8327:                 $defquota = $quotahash{'quotas'}{'default'};
                   8328:             }
1.536     raeburn  8329:             $settingstatus = 'default';
                   8330:         }
                   8331:     } else {
                   8332:         $settingstatus = 'default';
                   8333:         $defquota = 20;
                   8334:     }
                   8335:     if (wantarray) {
                   8336:         return ($defquota,$settingstatus);
1.472     raeburn  8337:     } else {
1.536     raeburn  8338:         return $defquota;
1.472     raeburn  8339:     }
                   8340: }
                   8341: 
1.384     raeburn  8342: sub get_secgrprole_info {
                   8343:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8344:     my %sections_count = &get_sections($cdom,$cnum);
                   8345:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8346:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8347:     my @groups = sort(keys(%curr_groups));
                   8348:     my $allroles = [];
                   8349:     my $rolehash;
                   8350:     my $accesshash = {
                   8351:                      active => 'Currently has access',
                   8352:                      future => 'Will have future access',
                   8353:                      previous => 'Previously had access',
                   8354:                   };
                   8355:     if ($needroles) {
                   8356:         $rolehash = {'all' => 'all'};
1.385     albertel 8357:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8358: 	if (&Apache::lonnet::error(%user_roles)) {
                   8359: 	    undef(%user_roles);
                   8360: 	}
                   8361:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  8362:             my ($role)=split(/\:/,$item,2);
                   8363:             if ($role eq 'cr') { next; }
                   8364:             if ($role =~ /^cr/) {
                   8365:                 $$rolehash{$role} = (split('/',$role))[3];
                   8366:             } else {
                   8367:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   8368:             }
                   8369:         }
                   8370:         foreach my $key (sort(keys(%{$rolehash}))) {
                   8371:             push(@{$allroles},$key);
                   8372:         }
                   8373:         push (@{$allroles},'st');
                   8374:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   8375:     }
                   8376:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   8377: }
                   8378: 
1.555     raeburn  8379: sub user_picker {
1.994     raeburn  8380:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  8381:     my $currdom = $dom;
                   8382:     my %curr_selected = (
                   8383:                         srchin => 'dom',
1.580     raeburn  8384:                         srchby => 'lastname',
1.555     raeburn  8385:                       );
                   8386:     my $srchterm;
1.625     raeburn  8387:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  8388:         if ($srch->{'srchby'} ne '') {
                   8389:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   8390:         }
                   8391:         if ($srch->{'srchin'} ne '') {
                   8392:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   8393:         }
                   8394:         if ($srch->{'srchtype'} ne '') {
                   8395:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   8396:         }
                   8397:         if ($srch->{'srchdomain'} ne '') {
                   8398:             $currdom = $srch->{'srchdomain'};
                   8399:         }
                   8400:         $srchterm = $srch->{'srchterm'};
                   8401:     }
                   8402:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  8403:                     'usr'       => 'Search criteria',
1.563     raeburn  8404:                     'doma'      => 'Domain/institution to search',
1.558     albertel 8405:                     'uname'     => 'username',
                   8406:                     'lastname'  => 'last name',
1.555     raeburn  8407:                     'lastfirst' => 'last name, first name',
1.558     albertel 8408:                     'crs'       => 'in this course',
1.576     raeburn  8409:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 8410:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  8411:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 8412:                     'exact'     => 'is',
                   8413:                     'contains'  => 'contains',
1.569     raeburn  8414:                     'begins'    => 'begins with',
1.571     raeburn  8415:                     'youm'      => "You must include some text to search for.",
                   8416:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   8417:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   8418:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   8419:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   8420:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   8421:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   8422:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  8423:                                        );
1.563     raeburn  8424:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   8425:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  8426: 
                   8427:     my @srchins = ('crs','dom','alc','instd');
                   8428: 
                   8429:     foreach my $option (@srchins) {
                   8430:         # FIXME 'alc' option unavailable until 
                   8431:         #       loncreateuser::print_user_query_page()
                   8432:         #       has been completed.
                   8433:         next if ($option eq 'alc');
1.880     raeburn  8434:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  8435:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  8436:         if ($curr_selected{'srchin'} eq $option) {
                   8437:             $srchinsel .= ' 
                   8438:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8439:         } else {
                   8440:             $srchinsel .= '
                   8441:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8442:         }
1.555     raeburn  8443:     }
1.563     raeburn  8444:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  8445: 
                   8446:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  8447:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  8448:         if ($curr_selected{'srchby'} eq $option) {
                   8449:             $srchbysel .= '
                   8450:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8451:         } else {
                   8452:             $srchbysel .= '
                   8453:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8454:          }
                   8455:     }
                   8456:     $srchbysel .= "\n  </select>\n";
                   8457: 
                   8458:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  8459:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  8460:         if ($curr_selected{'srchtype'} eq $option) {
                   8461:             $srchtypesel .= '
                   8462:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   8463:         } else {
                   8464:             $srchtypesel .= '
                   8465:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   8466:         }
                   8467:     }
                   8468:     $srchtypesel .= "\n  </select>\n";
                   8469: 
1.558     albertel 8470:     my ($newuserscript,$new_user_create);
1.994     raeburn  8471:     my $context_dom = $env{'request.role.domain'};
                   8472:     if ($context eq 'requestcrs') {
                   8473:         if ($env{'form.coursedom'} ne '') { 
                   8474:             $context_dom = $env{'form.coursedom'};
                   8475:         }
                   8476:     }
1.556     raeburn  8477:     if ($forcenewuser) {
1.576     raeburn  8478:         if (ref($srch) eq 'HASH') {
1.994     raeburn  8479:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  8480:                 if ($cancreate) {
                   8481:                     $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>';
                   8482:                 } else {
1.799     bisitz   8483:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  8484:                     my %usertypetext = (
                   8485:                         official   => 'institutional',
                   8486:                         unofficial => 'non-institutional',
                   8487:                     );
1.799     bisitz   8488:                     $new_user_create = '<p class="LC_warning">'
                   8489:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   8490:                                       .' '
                   8491:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   8492:                                           ,'<a href="'.$helplink.'">','</a>')
                   8493:                                       .'</p><br />';
1.627     raeburn  8494:                 }
1.576     raeburn  8495:             }
                   8496:         }
                   8497: 
1.556     raeburn  8498:         $newuserscript = <<"ENDSCRIPT";
                   8499: 
1.570     raeburn  8500: function setSearch(createnew,callingForm) {
1.556     raeburn  8501:     if (createnew == 1) {
1.570     raeburn  8502:         for (var i=0; i<callingForm.srchby.length; i++) {
                   8503:             if (callingForm.srchby.options[i].value == 'uname') {
                   8504:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  8505:             }
                   8506:         }
1.570     raeburn  8507:         for (var i=0; i<callingForm.srchin.length; i++) {
                   8508:             if ( callingForm.srchin.options[i].value == 'dom') {
                   8509: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  8510:             }
                   8511:         }
1.570     raeburn  8512:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   8513:             if (callingForm.srchtype.options[i].value == 'exact') {
                   8514:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  8515:             }
                   8516:         }
1.570     raeburn  8517:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  8518:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  8519:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  8520:             }
                   8521:         }
                   8522:     }
                   8523: }
                   8524: ENDSCRIPT
1.558     albertel 8525: 
1.556     raeburn  8526:     }
                   8527: 
1.555     raeburn  8528:     my $output = <<"END_BLOCK";
1.556     raeburn  8529: <script type="text/javascript">
1.824     bisitz   8530: // <![CDATA[
1.570     raeburn  8531: function validateEntry(callingForm) {
1.558     albertel 8532: 
1.556     raeburn  8533:     var checkok = 1;
1.558     albertel 8534:     var srchin;
1.570     raeburn  8535:     for (var i=0; i<callingForm.srchin.length; i++) {
                   8536: 	if ( callingForm.srchin[i].checked ) {
                   8537: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 8538: 	}
                   8539:     }
                   8540: 
1.570     raeburn  8541:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   8542:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   8543:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   8544:     var srchterm =  callingForm.srchterm.value;
                   8545:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  8546:     var msg = "";
                   8547: 
                   8548:     if (srchterm == "") {
                   8549:         checkok = 0;
1.571     raeburn  8550:         msg += "$lt{'youm'}\\n";
1.556     raeburn  8551:     }
                   8552: 
1.569     raeburn  8553:     if (srchtype== 'begins') {
                   8554:         if (srchterm.length < 2) {
                   8555:             checkok = 0;
1.571     raeburn  8556:             msg += "$lt{'thte'}\\n";
1.569     raeburn  8557:         }
                   8558:     }
                   8559: 
1.556     raeburn  8560:     if (srchtype== 'contains') {
                   8561:         if (srchterm.length < 3) {
                   8562:             checkok = 0;
1.571     raeburn  8563:             msg += "$lt{'thet'}\\n";
1.556     raeburn  8564:         }
                   8565:     }
                   8566:     if (srchin == 'instd') {
                   8567:         if (srchdomain == '') {
                   8568:             checkok = 0;
1.571     raeburn  8569:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  8570:         }
                   8571:     }
                   8572:     if (srchin == 'dom') {
                   8573:         if (srchdomain == '') {
                   8574:             checkok = 0;
1.571     raeburn  8575:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  8576:         }
                   8577:     }
                   8578:     if (srchby == 'lastfirst') {
                   8579:         if (srchterm.indexOf(",") == -1) {
                   8580:             checkok = 0;
1.571     raeburn  8581:             msg += "$lt{'whus'}\\n";
1.556     raeburn  8582:         }
                   8583:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   8584:             checkok = 0;
1.571     raeburn  8585:             msg += "$lt{'whse'}\\n";
1.556     raeburn  8586:         }
                   8587:     }
                   8588:     if (checkok == 0) {
1.571     raeburn  8589:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  8590:         return;
                   8591:     }
                   8592:     if (checkok == 1) {
1.570     raeburn  8593:         callingForm.submit();
1.556     raeburn  8594:     }
                   8595: }
                   8596: 
                   8597: $newuserscript
                   8598: 
1.824     bisitz   8599: // ]]>
1.556     raeburn  8600: </script>
1.558     albertel 8601: 
                   8602: $new_user_create
                   8603: 
1.555     raeburn  8604: END_BLOCK
1.558     albertel 8605: 
1.876     raeburn  8606:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   8607:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   8608:                $domform.
                   8609:                &Apache::lonhtmlcommon::row_closure().
                   8610:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   8611:                $srchbysel.
                   8612:                $srchtypesel. 
                   8613:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   8614:                $srchinsel.
                   8615:                &Apache::lonhtmlcommon::row_closure(1). 
                   8616:                &Apache::lonhtmlcommon::end_pick_box().
                   8617:                '<br />';
1.555     raeburn  8618:     return $output;
                   8619: }
                   8620: 
1.612     raeburn  8621: sub user_rule_check {
1.615     raeburn  8622:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  8623:     my $response;
                   8624:     if (ref($usershash) eq 'HASH') {
                   8625:         foreach my $user (keys(%{$usershash})) {
                   8626:             my ($uname,$udom) = split(/:/,$user);
                   8627:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  8628:             my ($id,$newuser);
1.612     raeburn  8629:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  8630:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  8631:                 $id = $usershash->{$user}->{'id'};
                   8632:             }
                   8633:             my $inst_response;
                   8634:             if (ref($checks) eq 'HASH') {
                   8635:                 if (defined($checks->{'username'})) {
1.615     raeburn  8636:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  8637:                         &Apache::lonnet::get_instuser($udom,$uname);
                   8638:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  8639:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  8640:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   8641:                 }
1.615     raeburn  8642:             } else {
                   8643:                 ($inst_response,%{$inst_results->{$user}}) =
                   8644:                     &Apache::lonnet::get_instuser($udom,$uname);
                   8645:                 return;
1.612     raeburn  8646:             }
1.615     raeburn  8647:             if (!$got_rules->{$udom}) {
1.612     raeburn  8648:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   8649:                                                   ['usercreation'],$udom);
                   8650:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  8651:                     foreach my $item ('username','id') {
1.612     raeburn  8652:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   8653:                             $$curr_rules{$udom}{$item} = 
                   8654:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  8655:                         }
                   8656:                     }
                   8657:                 }
1.615     raeburn  8658:                 $got_rules->{$udom} = 1;  
1.585     raeburn  8659:             }
1.612     raeburn  8660:             foreach my $item (keys(%{$checks})) {
                   8661:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   8662:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   8663:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   8664:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   8665:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   8666:                                 if ($rule_check{$rule}) {
                   8667:                                     $$rulematch{$user}{$item} = $rule;
                   8668:                                     if ($inst_response eq 'ok') {
1.615     raeburn  8669:                                         if (ref($inst_results) eq 'HASH') {
                   8670:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   8671:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   8672:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   8673:                                                 }
1.612     raeburn  8674:                                             }
                   8675:                                         }
1.615     raeburn  8676:                                     }
                   8677:                                     last;
1.585     raeburn  8678:                                 }
                   8679:                             }
                   8680:                         }
                   8681:                     }
                   8682:                 }
                   8683:             }
                   8684:         }
                   8685:     }
1.612     raeburn  8686:     return;
                   8687: }
                   8688: 
                   8689: sub user_rule_formats {
                   8690:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   8691:     my %text = ( 
                   8692:                  'username' => 'Usernames',
                   8693:                  'id'       => 'IDs',
                   8694:                );
                   8695:     my $output;
                   8696:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   8697:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   8698:         if (@{$ruleorder} > 0) {
                   8699:             $output = '<br />'.&mt("$text{$check} with the following format(s) may <span class=\"LC_cusr_emph\">only</span> be used for verified users at [_1]:",$domdesc).' <ul>';
                   8700:             foreach my $rule (@{$ruleorder}) {
                   8701:                 if (ref($curr_rules) eq 'ARRAY') {
                   8702:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   8703:                         if (ref($rules->{$rule}) eq 'HASH') {
                   8704:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   8705:                                         $rules->{$rule}{'desc'}.'</li>';
                   8706:                         }
                   8707:                     }
                   8708:                 }
                   8709:             }
                   8710:             $output .= '</ul>';
                   8711:         }
                   8712:     }
                   8713:     return $output;
                   8714: }
                   8715: 
                   8716: sub instrule_disallow_msg {
1.615     raeburn  8717:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  8718:     my $response;
                   8719:     my %text = (
                   8720:                   item   => 'username',
                   8721:                   items  => 'usernames',
                   8722:                   match  => 'matches',
                   8723:                   do     => 'does',
                   8724:                   action => 'a username',
                   8725:                   one    => 'one',
                   8726:                );
                   8727:     if ($count > 1) {
                   8728:         $text{'item'} = 'usernames';
                   8729:         $text{'match'} ='match';
                   8730:         $text{'do'} = 'do';
                   8731:         $text{'action'} = 'usernames',
                   8732:         $text{'one'} = 'ones';
                   8733:     }
                   8734:     if ($checkitem eq 'id') {
                   8735:         $text{'items'} = 'IDs';
                   8736:         $text{'item'} = 'ID';
                   8737:         $text{'action'} = 'an ID';
1.615     raeburn  8738:         if ($count > 1) {
                   8739:             $text{'item'} = 'IDs';
                   8740:             $text{'action'} = 'IDs';
                   8741:         }
1.612     raeburn  8742:     }
1.674     bisitz   8743:     $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  8744:     if ($mode eq 'upload') {
                   8745:         if ($checkitem eq 'username') {
                   8746:             $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'}.");
                   8747:         } elsif ($checkitem eq 'id') {
1.674     bisitz   8748:             $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  8749:         }
1.669     raeburn  8750:     } elsif ($mode eq 'selfcreate') {
                   8751:         if ($checkitem eq 'id') {
                   8752:             $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.");
                   8753:         }
1.615     raeburn  8754:     } else {
                   8755:         if ($checkitem eq 'username') {
                   8756:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   8757:         } elsif ($checkitem eq 'id') {
                   8758:             $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.");
                   8759:         }
1.612     raeburn  8760:     }
                   8761:     return $response;
1.585     raeburn  8762: }
                   8763: 
1.624     raeburn  8764: sub personal_data_fieldtitles {
                   8765:     my %fieldtitles = &Apache::lonlocal::texthash (
                   8766:                         id => 'Student/Employee ID',
                   8767:                         permanentemail => 'E-mail address',
                   8768:                         lastname => 'Last Name',
                   8769:                         firstname => 'First Name',
                   8770:                         middlename => 'Middle Name',
                   8771:                         generation => 'Generation',
                   8772:                         gen => 'Generation',
1.765     raeburn  8773:                         inststatus => 'Affiliation',
1.624     raeburn  8774:                    );
                   8775:     return %fieldtitles;
                   8776: }
                   8777: 
1.642     raeburn  8778: sub sorted_inst_types {
                   8779:     my ($dom) = @_;
                   8780:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   8781:     my $othertitle = &mt('All users');
                   8782:     if ($env{'request.course.id'}) {
1.668     raeburn  8783:         $othertitle  = &mt('Any users');
1.642     raeburn  8784:     }
                   8785:     my @types;
                   8786:     if (ref($order) eq 'ARRAY') {
                   8787:         @types = @{$order};
                   8788:     }
                   8789:     if (@types == 0) {
                   8790:         if (ref($usertypes) eq 'HASH') {
                   8791:             @types = sort(keys(%{$usertypes}));
                   8792:         }
                   8793:     }
                   8794:     if (keys(%{$usertypes}) > 0) {
                   8795:         $othertitle = &mt('Other users');
                   8796:     }
                   8797:     return ($othertitle,$usertypes,\@types);
                   8798: }
                   8799: 
1.645     raeburn  8800: sub get_institutional_codes {
                   8801:     my ($settings,$allcourses,$LC_code) = @_;
                   8802: # Get complete list of course sections to update
                   8803:     my @currsections = ();
                   8804:     my @currxlists = ();
                   8805:     my $coursecode = $$settings{'internal.coursecode'};
                   8806: 
                   8807:     if ($$settings{'internal.sectionnums'} ne '') {
                   8808:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   8809:     }
                   8810: 
                   8811:     if ($$settings{'internal.crosslistings'} ne '') {
                   8812:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   8813:     }
                   8814: 
                   8815:     if (@currxlists > 0) {
                   8816:         foreach (@currxlists) {
                   8817:             if (m/^([^:]+):(\w*)$/) {
                   8818:                 unless (grep/^$1$/,@{$allcourses}) {
                   8819:                     push @{$allcourses},$1;
                   8820:                     $$LC_code{$1} = $2;
                   8821:                 }
                   8822:             }
                   8823:         }
                   8824:     }
                   8825:  
                   8826:     if (@currsections > 0) {
                   8827:         foreach (@currsections) {
                   8828:             if (m/^(\w+):(\w*)$/) {
                   8829:                 my $sec = $coursecode.$1;
                   8830:                 my $lc_sec = $2;
                   8831:                 unless (grep/^$sec$/,@{$allcourses}) {
                   8832:                     push @{$allcourses},$sec;
                   8833:                     $$LC_code{$sec} = $lc_sec;
                   8834:                 }
                   8835:             }
                   8836:         }
                   8837:     }
                   8838:     return;
                   8839: }
                   8840: 
1.971     raeburn  8841: sub get_standard_codeitems {
                   8842:     return ('Year','Semester','Department','Number','Section');
                   8843: }
                   8844: 
1.112     bowersj2 8845: =pod
                   8846: 
1.780     raeburn  8847: =head1 Slot Helpers
                   8848: 
                   8849: =over 4
                   8850: 
                   8851: =item * sorted_slots()
                   8852: 
1.1040    raeburn  8853: Sorts an array of slot names in order of an optional sort key,
                   8854: default sort is by slot start time (earliest first). 
1.780     raeburn  8855: 
                   8856: Inputs:
                   8857: 
                   8858: =over 4
                   8859: 
                   8860: slotsarr  - Reference to array of unsorted slot names.
                   8861: 
                   8862: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   8863: 
1.1040    raeburn  8864: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   8865: 
1.549     albertel 8866: =back
                   8867: 
1.780     raeburn  8868: Returns:
                   8869: 
                   8870: =over 4
                   8871: 
1.1040    raeburn  8872: sorted   - An array of slot names sorted by a specified sort key 
                   8873:            (default sort key is start time of the slot).
1.780     raeburn  8874: 
                   8875: =back
                   8876: 
                   8877: =cut
                   8878: 
                   8879: 
                   8880: sub sorted_slots {
1.1040    raeburn  8881:     my ($slotsarr,$slots,$sortkey) = @_;
                   8882:     if ($sortkey eq '') {
                   8883:         $sortkey = 'starttime';
                   8884:     }
1.780     raeburn  8885:     my @sorted;
                   8886:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   8887:         @sorted =
                   8888:             sort {
                   8889:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  8890:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  8891:                      }
                   8892:                      if (ref($slots->{$a})) { return -1;}
                   8893:                      if (ref($slots->{$b})) { return 1;}
                   8894:                      return 0;
                   8895:                  } @{$slotsarr};
                   8896:     }
                   8897:     return @sorted;
                   8898: }
                   8899: 
1.1040    raeburn  8900: =pod
                   8901: 
                   8902: =item * get_future_slots()
                   8903: 
                   8904: Inputs:
                   8905: 
                   8906: =over 4
                   8907: 
                   8908: cnum - course number
                   8909: 
                   8910: cdom - course domain
                   8911: 
                   8912: now - current UNIX time
                   8913: 
                   8914: symb - optional symb
                   8915: 
                   8916: =back
                   8917: 
                   8918: Returns:
                   8919: 
                   8920: =over 4
                   8921: 
                   8922: sorted_reservable - ref to array of student_schedulable slots currently 
                   8923:                     reservable, ordered by end date of reservation period.
                   8924: 
                   8925: reservable_now - ref to hash of student_schedulable slots currently
                   8926:                  reservable.
                   8927: 
                   8928:     Keys in inner hash are:
                   8929:     (a) symb: either blank or symb to which slot use is restricted.
                   8930:     (b) endreserve: end date of reservation period. 
                   8931: 
                   8932: sorted_future - ref to array of student_schedulable slots reservable in
                   8933:                 the future, ordered by start date of reservation period.
                   8934: 
                   8935: future_reservable - ref to hash of student_schedulable slots reservable
                   8936:                     in the future.
                   8937: 
                   8938:     Keys in inner hash are:
                   8939:     (a) symb: either blank or symb to which slot use is restricted.
                   8940:     (b) startreserve:  start date of reservation period.
                   8941: 
                   8942: =back
                   8943: 
                   8944: =cut
                   8945: 
                   8946: sub get_future_slots {
                   8947:     my ($cnum,$cdom,$now,$symb) = @_;
                   8948:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   8949:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   8950:     foreach my $slot (keys(%slots)) {
                   8951:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   8952:         if ($symb) {
                   8953:             next if (($slots{$slot}->{'symb'} ne '') && 
                   8954:                      ($slots{$slot}->{'symb'} ne $symb));
                   8955:         }
                   8956:         if (($slots{$slot}->{'starttime'} > $now) &&
                   8957:             ($slots{$slot}->{'endtime'} > $now)) {
                   8958:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   8959:                 my $userallowed = 0;
                   8960:                 if ($slots{$slot}->{'allowedsections'}) {
                   8961:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   8962:                     if (!defined($env{'request.role.sec'})
                   8963:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   8964:                         $userallowed=1;
                   8965:                     } else {
                   8966:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   8967:                             $userallowed=1;
                   8968:                         }
                   8969:                     }
                   8970:                     unless ($userallowed) {
                   8971:                         if (defined($env{'request.course.groups'})) {
                   8972:                             my @groups = split(/:/,$env{'request.course.groups'});
                   8973:                             foreach my $group (@groups) {
                   8974:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   8975:                                     $userallowed=1;
                   8976:                                     last;
                   8977:                                 }
                   8978:                             }
                   8979:                         }
                   8980:                     }
                   8981:                 }
                   8982:                 if ($slots{$slot}->{'allowedusers'}) {
                   8983:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   8984:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   8985:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   8986:                         $userallowed = 1;
                   8987:                     }
                   8988:                 }
                   8989:                 next unless($userallowed);
                   8990:             }
                   8991:             my $startreserve = $slots{$slot}->{'startreserve'};
                   8992:             my $endreserve = $slots{$slot}->{'endreserve'};
                   8993:             my $symb = $slots{$slot}->{'symb'};
                   8994:             if (($startreserve < $now) &&
                   8995:                 (!$endreserve || $endreserve > $now)) {
                   8996:                 my $lastres = $endreserve;
                   8997:                 if (!$lastres) {
                   8998:                     $lastres = $slots{$slot}->{'starttime'};
                   8999:                 }
                   9000:                 $reservable_now{$slot} = {
                   9001:                                            symb       => $symb,
                   9002:                                            endreserve => $lastres
                   9003:                                          };
                   9004:             } elsif (($startreserve > $now) &&
                   9005:                      (!$endreserve || $endreserve > $startreserve)) {
                   9006:                 $future_reservable{$slot} = {
                   9007:                                               symb         => $symb,
                   9008:                                               startreserve => $startreserve
                   9009:                                             };
                   9010:             }
                   9011:         }
                   9012:     }
                   9013:     my @unsorted_reservable = keys(%reservable_now);
                   9014:     if (@unsorted_reservable > 0) {
                   9015:         @sorted_reservable = 
                   9016:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9017:     }
                   9018:     my @unsorted_future = keys(%future_reservable);
                   9019:     if (@unsorted_future > 0) {
                   9020:         @sorted_future =
                   9021:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9022:     }
                   9023:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9024: }
1.780     raeburn  9025: 
                   9026: =pod
                   9027: 
1.1057    foxr     9028: =back
                   9029: 
1.549     albertel 9030: =head1 HTTP Helpers
                   9031: 
                   9032: =over 4
                   9033: 
1.648     raeburn  9034: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9035: 
1.258     albertel 9036: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9037: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9038: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9039: 
                   9040: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9041: $possible_names is an ref to an array of form element names.  As an example:
                   9042: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9043: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9044: 
                   9045: =cut
1.1       albertel 9046: 
1.6       albertel 9047: sub get_unprocessed_cgi {
1.25      albertel 9048:   my ($query,$possible_names)= @_;
1.26      matthew  9049:   # $Apache::lonxml::debug=1;
1.356     albertel 9050:   foreach my $pair (split(/&/,$query)) {
                   9051:     my ($name, $value) = split(/=/,$pair);
1.369     www      9052:     $name = &unescape($name);
1.25      albertel 9053:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9054:       $value =~ tr/+/ /;
                   9055:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9056:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9057:     }
1.16      harris41 9058:   }
1.6       albertel 9059: }
                   9060: 
1.112     bowersj2 9061: =pod
                   9062: 
1.648     raeburn  9063: =item * &cacheheader() 
1.112     bowersj2 9064: 
                   9065: returns cache-controlling header code
                   9066: 
                   9067: =cut
                   9068: 
1.7       albertel 9069: sub cacheheader {
1.258     albertel 9070:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9071:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9072:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9073:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9074:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9075:     return $output;
1.7       albertel 9076: }
                   9077: 
1.112     bowersj2 9078: =pod
                   9079: 
1.648     raeburn  9080: =item * &no_cache($r) 
1.112     bowersj2 9081: 
                   9082: specifies header code to not have cache
                   9083: 
                   9084: =cut
                   9085: 
1.9       albertel 9086: sub no_cache {
1.216     albertel 9087:     my ($r) = @_;
                   9088:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9089: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9090:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9091:     $r->no_cache(1);
                   9092:     $r->header_out("Expires" => $date);
                   9093:     $r->header_out("Pragma" => "no-cache");
1.123     www      9094: }
                   9095: 
                   9096: sub content_type {
1.181     albertel 9097:     my ($r,$type,$charset) = @_;
1.299     foxr     9098:     if ($r) {
                   9099: 	#  Note that printout.pl calls this with undef for $r.
                   9100: 	&no_cache($r);
                   9101:     }
1.258     albertel 9102:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9103:     unless ($charset) {
                   9104: 	$charset=&Apache::lonlocal::current_encoding;
                   9105:     }
                   9106:     if ($charset) { $type.='; charset='.$charset; }
                   9107:     if ($r) {
                   9108: 	$r->content_type($type);
                   9109:     } else {
                   9110: 	print("Content-type: $type\n\n");
                   9111:     }
1.9       albertel 9112: }
1.25      albertel 9113: 
1.112     bowersj2 9114: =pod
                   9115: 
1.648     raeburn  9116: =item * &add_to_env($name,$value) 
1.112     bowersj2 9117: 
1.258     albertel 9118: adds $name to the %env hash with value
1.112     bowersj2 9119: $value, if $name already exists, the entry is converted to an array
                   9120: reference and $value is added to the array.
                   9121: 
                   9122: =cut
                   9123: 
1.25      albertel 9124: sub add_to_env {
                   9125:   my ($name,$value)=@_;
1.258     albertel 9126:   if (defined($env{$name})) {
                   9127:     if (ref($env{$name})) {
1.25      albertel 9128:       #already have multiple values
1.258     albertel 9129:       push(@{ $env{$name} },$value);
1.25      albertel 9130:     } else {
                   9131:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9132:       my $first=$env{$name};
                   9133:       undef($env{$name});
                   9134:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9135:     }
                   9136:   } else {
1.258     albertel 9137:     $env{$name}=$value;
1.25      albertel 9138:   }
1.31      albertel 9139: }
1.149     albertel 9140: 
                   9141: =pod
                   9142: 
1.648     raeburn  9143: =item * &get_env_multiple($name) 
1.149     albertel 9144: 
1.258     albertel 9145: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9146: values may be defined and end up as an array ref.
                   9147: 
                   9148: returns an array of values
                   9149: 
                   9150: =cut
                   9151: 
                   9152: sub get_env_multiple {
                   9153:     my ($name) = @_;
                   9154:     my @values;
1.258     albertel 9155:     if (defined($env{$name})) {
1.149     albertel 9156:         # exists is it an array
1.258     albertel 9157:         if (ref($env{$name})) {
                   9158:             @values=@{ $env{$name} };
1.149     albertel 9159:         } else {
1.258     albertel 9160:             $values[0]=$env{$name};
1.149     albertel 9161:         }
                   9162:     }
                   9163:     return(@values);
                   9164: }
                   9165: 
1.660     raeburn  9166: sub ask_for_embedded_content {
                   9167:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9168:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
                   9169:         %currsubfile,%unused);
                   9170:     my $counter = 0;
                   9171:     my $numnew = 0;
1.987     raeburn  9172:     my $numremref = 0;
                   9173:     my $numinvalid = 0;
                   9174:     my $numpathchg = 0;
                   9175:     my $numexisting = 0;
1.1071    raeburn  9176:     my $numunused = 0;
                   9177:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
                   9178:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
                   9179:     my $heading = &mt('Upload embedded files');
                   9180:     my $buttontext = &mt('Upload');
                   9181: 
1.984     raeburn  9182:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9183:         my $current_path='/';
                   9184:         if ($env{'form.currentpath'}) {
                   9185:             $current_path = $env{'form.currentpath'};
                   9186:         }
                   9187:         if ($actionurl eq '/adm/coursegrp_portfolio') {
                   9188:             $udom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9189:             $uname = $env{'course.'.$env{'request.course.id'}.'.num'};
                   9190:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9191:         } else {
                   9192:             $udom = $env{'user.domain'};
                   9193:             $uname = $env{'user.name'};
                   9194:             $url = '/userfiles/portfolio';
                   9195:         }
1.987     raeburn  9196:         $toplevel = $url.'/';
1.984     raeburn  9197:         $url .= $current_path;
                   9198:         $getpropath = 1;
1.987     raeburn  9199:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9200:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9201:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9202:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9203:         $toplevel = $url;
1.984     raeburn  9204:         if ($rest ne '') {
1.987     raeburn  9205:             $url .= $rest;
                   9206:         }
                   9207:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9208:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9209:             $url = $args->{'docs_url'};
                   9210:             $toplevel = $url;
                   9211:         }
                   9212:     } elsif ($actionurl eq '/adm/dependencies') {
                   9213:         if ($env{'request.course.id'} ne '') {
                   9214:             $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9215:             $cnum =  $env{'course.'.$env{'request.course.id'}.'.num'};
                   9216:             if (ref($args) eq 'HASH') {
                   9217:                 $url = $args->{'docs_url'};
                   9218:                 $title = $args->{'docs_title'};
                   9219:                 $toplevel = "/$url";
                   9220:                 ($path) =  
                   9221:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9222:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9223:                 $fileloc =~ s{^/}{};
                   9224:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9225:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9226:             }
1.987     raeburn  9227:         }
                   9228:     }
                   9229:     my $now = time();
                   9230:     foreach my $embed_file (keys(%{$allfiles})) {
                   9231:         my $absolutepath;
                   9232:         if ($embed_file =~ m{^\w+://}) {
                   9233:             $newfiles{$embed_file} = 1;
                   9234:             $mapping{$embed_file} = $embed_file;
                   9235:         } else {
                   9236:             if ($embed_file =~ m{^/}) {
                   9237:                 $absolutepath = $embed_file;
                   9238:                 $embed_file =~ s{^(/+)}{};
                   9239:             }
                   9240:             if ($embed_file =~ m{/}) {
                   9241:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   9242:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9243:                 my $item = $fname;
                   9244:                 if ($path ne '') {
                   9245:                     $item = $path.'/'.$fname;
                   9246:                     $subdependencies{$path}{$fname} = 1;
                   9247:                 } else {
                   9248:                     $dependencies{$item} = 1;
                   9249:                 }
                   9250:                 if ($absolutepath) {
                   9251:                     $mapping{$item} = $absolutepath;
                   9252:                 } else {
                   9253:                     $mapping{$item} = $embed_file;
                   9254:                 }
                   9255:             } else {
                   9256:                 $dependencies{$embed_file} = 1;
                   9257:                 if ($absolutepath) {
                   9258:                     $mapping{$embed_file} = $absolutepath;
                   9259:                 } else {
                   9260:                     $mapping{$embed_file} = $embed_file;
                   9261:                 }
                   9262:             }
1.984     raeburn  9263:         }
                   9264:     }
1.1071    raeburn  9265:     my $dirptr = 16384;
1.984     raeburn  9266:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9267:         $currsubfile{$path} = {};
1.984     raeburn  9268:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  9269:             my ($sublistref,$listerror) =
                   9270:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9271:             if (ref($sublistref) eq 'ARRAY') {
                   9272:                 foreach my $line (@{$sublistref}) {
                   9273:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9274:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9275:                 }
1.984     raeburn  9276:             }
1.987     raeburn  9277:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9278:             if (opendir(my $dir,$url.'/'.$path)) {
                   9279:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9280:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9281:             }
                   9282:         } elsif ($actionurl eq '/adm/dependencies') {
                   9283:             if ($env{'request.course.id'} ne '') {
                   9284:                 my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9285:                 if ($dir ne '') {
                   9286:                     my ($sublistref,$listerror) =
                   9287:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9288:                     if (ref($sublistref) eq 'ARRAY') {
                   9289:                         foreach my $line (@{$sublistref}) {
                   9290:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9291:                                 undef,$mtime)=split(/\&/,$line,12);
                   9292:                             unless (($testdir&$dirptr) ||
                   9293:                                     ($file_name =~ /^\.\.?$/)) {
                   9294:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9295:                             }
                   9296:                         }
                   9297:                     }
                   9298:                 }
1.984     raeburn  9299:             }
                   9300:         }
                   9301:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  9302:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  9303:                 my $item = $path.'/'.$file;
                   9304:                 unless ($mapping{$item} eq $item) {
                   9305:                     $pathchanges{$item} = 1;
                   9306:                 }
                   9307:                 $existing{$item} = 1;
                   9308:                 $numexisting ++;
                   9309:             } else {
                   9310:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  9311:             }
                   9312:         }
1.1071    raeburn  9313:         if ($actionurl eq '/adm/dependencies') {
                   9314:             foreach my $path (keys(%currsubfile)) {
                   9315:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   9316:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   9317:                          unless ($subdependencies{$path}{$file}) {
                   9318:                              $unused{$path.'/'.$file} = 1; 
                   9319:                          }
                   9320:                     }
                   9321:                 }
                   9322:             }
                   9323:         }
1.984     raeburn  9324:     }
1.987     raeburn  9325:     my %currfile;
1.984     raeburn  9326:     if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9327:         my ($dirlistref,$listerror) =
                   9328:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   9329:         if (ref($dirlistref) eq 'ARRAY') {
                   9330:             foreach my $line (@{$dirlistref}) {
                   9331:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   9332:                 $currfile{$file_name} = 1;
                   9333:             }
1.984     raeburn  9334:         }
1.987     raeburn  9335:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9336:         if (opendir(my $dir,$url)) {
1.987     raeburn  9337:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  9338:             map {$currfile{$_} = 1;} @dir_list;
                   9339:         }
1.1071    raeburn  9340:     } elsif ($actionurl eq '/adm/dependencies') {
                   9341:         if ($env{'request.course.id'} ne '') {
                   9342:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9343:             if ($dir ne '') {
                   9344:                 my ($dirlistref,$listerror) =
                   9345:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   9346:                 if (ref($dirlistref) eq 'ARRAY') {
                   9347:                     foreach my $line (@{$dirlistref}) {
                   9348:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   9349:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   9350:                         unless (($testdir&$dirptr) ||
                   9351:                                 ($file_name =~ /^\.\.?$/)) {
                   9352:                             $currfile{$file_name} = [$size,$mtime];
                   9353:                         }
                   9354:                     }
                   9355:                 }
                   9356:             }
                   9357:         }
1.984     raeburn  9358:     }
                   9359:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  9360:         if (exists($currfile{$file})) {
1.987     raeburn  9361:             unless ($mapping{$file} eq $file) {
                   9362:                 $pathchanges{$file} = 1;
                   9363:             }
                   9364:             $existing{$file} = 1;
                   9365:             $numexisting ++;
                   9366:         } else {
1.984     raeburn  9367:             $newfiles{$file} = 1;
                   9368:         }
                   9369:     }
1.1071    raeburn  9370:     foreach my $file (keys(%currfile)) {
                   9371:         unless (($file eq $filename) ||
                   9372:                 ($file eq $filename.'.bak') ||
                   9373:                 ($dependencies{$file})) {
                   9374:             $unused{$file} = 1;
                   9375:         }
                   9376:     }
1.984     raeburn  9377:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  9378:         if ($actionurl eq '/adm/dependencies') {
                   9379:             next if ($embed_file =~ m{^\w+://});
                   9380:         }
1.660     raeburn  9381:         $upload_output .= &start_data_table_row().
1.1071    raeburn  9382:                           '<td><img src="'.&icon($embed_file).'" />&nbsp;'.
                   9383:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  9384:         unless ($mapping{$embed_file} eq $embed_file) {
                   9385:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.&mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
                   9386:         }
                   9387:         $upload_output .= '</td><td>';
1.1071    raeburn  9388:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.660     raeburn  9389:             $upload_output.='<span class="LC_warning">'.&mt("URL points to other server.").'</span>';
1.987     raeburn  9390:             $numremref++;
1.660     raeburn  9391:         } elsif ($args->{'error_on_invalid_names'}
                   9392:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
                   9393: 
1.987     raeburn  9394:             $upload_output.='<span class="LC_warning">'.&mt('Invalid characters').'</span>';
                   9395:             $numinvalid++;
1.660     raeburn  9396:         } else {
1.1071    raeburn  9397:             $upload_output .= &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  9398:                                                      $embed_file,\%mapping,
1.1071    raeburn  9399:                                                      $allfiles,$codebase,'upload');
                   9400:             $counter ++;
                   9401:             $numnew ++;
1.987     raeburn  9402:         }
                   9403:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   9404:     }
                   9405:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  9406:         if ($actionurl eq '/adm/dependencies') {
                   9407:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   9408:             $modify_output .= &start_data_table_row().
                   9409:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   9410:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   9411:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   9412:                               '<td>'.$size.'</td>'.
                   9413:                               '<td>'.$mtime.'</td>'.
                   9414:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   9415:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   9416:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   9417:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   9418:                               &embedded_file_element('upload_embedded',$counter,
                   9419:                                                      $embed_file,\%mapping,
                   9420:                                                      $allfiles,$codebase,'modify').
                   9421:                               '</div></td>'.
                   9422:                               &end_data_table_row()."\n";
                   9423:             $counter ++;
                   9424:         } else {
                   9425:             $upload_output .= &start_data_table_row().
                   9426:                               '<td><span class="LC_filename">'.$embed_file.'</span></td>';
                   9427:                               '<td><span class="LC_warning">'.&mt('Already exists').'</span></td>'.
                   9428:                               &Apache::loncommon::end_data_table_row()."\n";
                   9429:         }
                   9430:     }
                   9431:     my $delidx = $counter;
                   9432:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   9433:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   9434:         $delete_output .= &start_data_table_row().
                   9435:                           '<td><img src="'.&icon($oldfile).'" />'.
                   9436:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   9437:                           '<td>'.$size.'</td>'.
                   9438:                           '<td>'.$mtime.'</td>'.
                   9439:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   9440:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   9441:                           &embedded_file_element('upload_embedded',$delidx,
                   9442:                                                  $oldfile,\%mapping,$allfiles,
                   9443:                                                  $codebase,'delete').'</td>'.
                   9444:                           &end_data_table_row()."\n"; 
                   9445:         $numunused ++;
                   9446:         $delidx ++;
1.987     raeburn  9447:     }
                   9448:     if ($upload_output) {
                   9449:         $upload_output = &start_data_table().
                   9450:                          $upload_output.
                   9451:                          &end_data_table()."\n";
                   9452:     }
1.1071    raeburn  9453:     if ($modify_output) {
                   9454:         $modify_output = &start_data_table().
                   9455:                          &start_data_table_header_row().
                   9456:                          '<th>'.&mt('File').'</th>'.
                   9457:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9458:                          '<th>'.&mt('Modified').'</th>'.
                   9459:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   9460:                          &end_data_table_header_row().
                   9461:                          $modify_output.
                   9462:                          &end_data_table()."\n";
                   9463:     }
                   9464:     if ($delete_output) {
                   9465:         $delete_output = &start_data_table().
                   9466:                          &start_data_table_header_row().
                   9467:                          '<th>'.&mt('File').'</th>'.
                   9468:                          '<th>'.&mt('Size (KB)').'</th>'.
                   9469:                          '<th>'.&mt('Modified').'</th>'.
                   9470:                          '<th>'.&mt('Delete?').'</th>'.
                   9471:                          &end_data_table_header_row().
                   9472:                          $delete_output.
                   9473:                          &end_data_table()."\n";
                   9474:     }
1.987     raeburn  9475:     my $applies = 0;
                   9476:     if ($numremref) {
                   9477:         $applies ++;
                   9478:     }
                   9479:     if ($numinvalid) {
                   9480:         $applies ++;
                   9481:     }
                   9482:     if ($numexisting) {
                   9483:         $applies ++;
                   9484:     }
1.1071    raeburn  9485:     if ($counter || $numunused) {
1.987     raeburn  9486:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   9487:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  9488:                   $state.'<h3>'.$heading.'</h3>'; 
                   9489:         if ($actionurl eq '/adm/dependencies') {
                   9490:             if ($numnew) {
                   9491:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   9492:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   9493:                            $upload_output.'<br />'."\n";
                   9494:             }
                   9495:             if ($numexisting) {
                   9496:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   9497:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   9498:                            $modify_output.'<br />'."\n";
                   9499:                            $buttontext = &mt('Save changes');
                   9500:             }
                   9501:             if ($numunused) {
                   9502:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   9503:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   9504:                            $delete_output.'<br />'."\n";
                   9505:                            $buttontext = &mt('Save changes');
                   9506:             }
                   9507:         } else {
                   9508:             $output .= $upload_output.'<br />'."\n";
                   9509:         }
                   9510:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   9511:                    $counter.'" />'."\n";
                   9512:         if ($actionurl eq '/adm/dependencies') { 
                   9513:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   9514:                        $numnew.'" />'."\n";
                   9515:         } elsif ($actionurl eq '') {
1.987     raeburn  9516:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   9517:         }
                   9518:     } elsif ($applies) {
                   9519:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   9520:         if ($applies > 1) {
                   9521:             $output .=  
                   9522:                 &mt('No files need to be uploaded, as one of the following applies to each reference:').'<ul>';
                   9523:             if ($numremref) {
                   9524:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   9525:             }
                   9526:             if ($numinvalid) {
                   9527:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   9528:             }
                   9529:             if ($numexisting) {
                   9530:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   9531:             }
                   9532:             $output .= '</ul><br />';
                   9533:         } elsif ($numremref) {
                   9534:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   9535:         } elsif ($numinvalid) {
                   9536:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   9537:         } elsif ($numexisting) {
                   9538:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   9539:         }
                   9540:         $output .= $upload_output.'<br />';
                   9541:     }
                   9542:     my ($pathchange_output,$chgcount);
1.1071    raeburn  9543:     $chgcount = $counter;
1.987     raeburn  9544:     if (keys(%pathchanges) > 0) {
                   9545:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  9546:             if ($counter) {
1.987     raeburn  9547:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   9548:                                                   $embed_file,\%mapping,
1.1071    raeburn  9549:                                                   $allfiles,$codebase,'change');
1.987     raeburn  9550:             } else {
                   9551:                 $pathchange_output .= 
                   9552:                     &start_data_table_row().
                   9553:                     '<td><input type ="checkbox" name="namechange" value="'.
                   9554:                     $chgcount.'" checked="checked" /></td>'.
                   9555:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   9556:                     '<td>'.$embed_file.
                   9557:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  9558:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  9559:                     '</td>'.&end_data_table_row();
1.660     raeburn  9560:             }
1.987     raeburn  9561:             $numpathchg ++;
                   9562:             $chgcount ++;
1.660     raeburn  9563:         }
                   9564:     }
1.1071    raeburn  9565:     if ($counter) {
1.987     raeburn  9566:         if ($numpathchg) {
                   9567:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   9568:                        $numpathchg.'" />'."\n";
                   9569:         }
                   9570:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   9571:             ($actionurl eq '/adm/imsimport')) {
                   9572:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   9573:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   9574:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  9575:         } elsif ($actionurl eq '/adm/dependencies') {
                   9576:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  9577:         }
1.1071    raeburn  9578:         $output .=  '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  9579:     } elsif ($numpathchg) {
                   9580:         my %pathchange = ();
                   9581:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   9582:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9583:             $output .= '<p>'.&mt('or').'</p>'; 
                   9584:         } 
                   9585:     }
1.1071    raeburn  9586:     return ($output,$counter,$numpathchg);
1.987     raeburn  9587: }
                   9588: 
                   9589: sub embedded_file_element {
1.1071    raeburn  9590:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  9591:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   9592:                    (ref($codebase) eq 'HASH'));
                   9593:     my $output;
1.1071    raeburn  9594:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  9595:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   9596:     }
                   9597:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   9598:                &escape($embed_file).'" />';
                   9599:     unless (($context eq 'upload_embedded') && 
                   9600:             ($mapping->{$embed_file} eq $embed_file)) {
                   9601:         $output .='
                   9602:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   9603:     }
                   9604:     my $attrib;
                   9605:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   9606:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   9607:     }
                   9608:     $output .=
                   9609:         "\n\t\t".
                   9610:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   9611:         $attrib.'" />';
                   9612:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   9613:         $output .=
                   9614:             "\n\t\t".
                   9615:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   9616:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  9617:     }
1.987     raeburn  9618:     return $output;
1.660     raeburn  9619: }
                   9620: 
1.1071    raeburn  9621: sub get_dependency_details {
                   9622:     my ($currfile,$currsubfile,$embed_file) = @_;
                   9623:     my ($size,$mtime,$showsize,$showmtime);
                   9624:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   9625:         if ($embed_file =~ m{/}) {
                   9626:             my ($path,$fname) = split(/\//,$embed_file);
                   9627:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   9628:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   9629:             }
                   9630:         } else {
                   9631:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   9632:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   9633:             }
                   9634:         }
                   9635:         $showsize = $size/1024.0;
                   9636:         $showsize = sprintf("%.1f",$showsize);
                   9637:         if ($mtime > 0) {
                   9638:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   9639:         }
                   9640:     }
                   9641:     return ($showsize,$showmtime);
                   9642: }
                   9643: 
                   9644: sub ask_embedded_js {
                   9645:     return <<"END";
                   9646: <script type="text/javascript"">
                   9647: // <![CDATA[
                   9648: function toggleBrowse(counter) {
                   9649:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   9650:     var fileid = document.getElementById('embedded_item_'+counter);
                   9651:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   9652:     if (chkboxid.checked == true) {
                   9653:         uploaddivid.style.display='block';
                   9654:     } else {
                   9655:         uploaddivid.style.display='none';
                   9656:         fileid.value = '';
                   9657:     }
                   9658: }
                   9659: // ]]>
                   9660: </script>
                   9661: 
                   9662: END
                   9663: }
                   9664: 
1.661     raeburn  9665: sub upload_embedded {
                   9666:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  9667:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   9668:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  9669:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   9670:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   9671:         my $orig_uploaded_filename =
                   9672:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  9673:         foreach my $type ('orig','ref','attrib','codebase') {
                   9674:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   9675:                 $env{'form.embedded_'.$type.'_'.$i} =
                   9676:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   9677:             }
                   9678:         }
1.661     raeburn  9679:         my ($path,$fname) =
                   9680:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   9681:         # no path, whole string is fname
                   9682:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   9683:         $fname = &Apache::lonnet::clean_filename($fname);
                   9684:         # See if there is anything left
                   9685:         next if ($fname eq '');
                   9686: 
                   9687:         # Check if file already exists as a file or directory.
                   9688:         my ($state,$msg);
                   9689:         if ($context eq 'portfolio') {
                   9690:             my $port_path = $dirpath;
                   9691:             if ($group ne '') {
                   9692:                 $port_path = "groups/$group/$port_path";
                   9693:             }
1.987     raeburn  9694:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   9695:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  9696:                                               $dir_root,$port_path,$disk_quota,
                   9697:                                               $current_disk_usage,$uname,$udom);
                   9698:             if ($state eq 'will_exceed_quota'
1.984     raeburn  9699:                 || $state eq 'file_locked') {
1.661     raeburn  9700:                 $output .= $msg;
                   9701:                 next;
                   9702:             }
                   9703:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   9704:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   9705:             if ($state eq 'exists') {
                   9706:                 $output .= $msg;
                   9707:                 next;
                   9708:             }
                   9709:         }
                   9710:         # Check if extension is valid
                   9711:         if (($fname =~ /\.(\w+)$/) &&
                   9712:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  9713:             $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  9714:             next;
                   9715:         } elsif (($fname =~ /\.(\w+)$/) &&
                   9716:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  9717:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  9718:             next;
                   9719:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.987     raeburn  9720:             $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  9721:             next;
                   9722:         }
                   9723:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
                   9724:         if ($context eq 'portfolio') {
1.984     raeburn  9725:             my $result;
                   9726:             if ($state eq 'existingfile') {
                   9727:                 $result=
                   9728:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.987     raeburn  9729:                                                     $dirpath.$env{'form.currentpath'}.$path);
1.661     raeburn  9730:             } else {
1.984     raeburn  9731:                 $result=
                   9732:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  9733:                                                     $dirpath.
                   9734:                                                     $env{'form.currentpath'}.$path);
1.984     raeburn  9735:                 if ($result !~ m|^/uploaded/|) {
                   9736:                     $output .= '<span class="LC_error">'
                   9737:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   9738:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   9739:                                .'</span><br />';
                   9740:                     next;
                   9741:                 } else {
1.987     raeburn  9742:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   9743:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  9744:                 }
1.661     raeburn  9745:             }
1.987     raeburn  9746:         } elsif ($context eq 'coursedoc') {
                   9747:             my $result =
                   9748:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,'coursedoc',
                   9749:                                                 $dirpath.'/'.$path);
                   9750:             if ($result !~ m|^/uploaded/|) {
                   9751:                 $output .= '<span class="LC_error">'
                   9752:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   9753:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   9754:                            .'</span><br />';
                   9755:                     next;
                   9756:             } else {
                   9757:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   9758:                            $path.$fname.'</span>').'<br />';
                   9759:             }
1.661     raeburn  9760:         } else {
                   9761: # Save the file
                   9762:             my $target = $env{'form.embedded_item_'.$i};
                   9763:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   9764:             my $dest = $fullpath.$fname;
                   9765:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  9766:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  9767:             my $count;
                   9768:             my $filepath = $dir_root;
1.1027    raeburn  9769:             foreach my $subdir (@parts) {
                   9770:                 $filepath .= "/$subdir";
                   9771:                 if (!-e $filepath) {
1.661     raeburn  9772:                     mkdir($filepath,0770);
                   9773:                 }
                   9774:             }
                   9775:             my $fh;
                   9776:             if (!open($fh,'>'.$dest)) {
                   9777:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   9778:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  9779:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   9780:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  9781:                            '</span><br />';
                   9782:             } else {
                   9783:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   9784:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   9785:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  9786:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   9787:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  9788:                               '</span><br />';
                   9789:                 } else {
1.987     raeburn  9790:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   9791:                                $url.'</span>').'<br />';
                   9792:                     unless ($context eq 'testbank') {
                   9793:                         $footer .= &mt('View embedded file: [_1]',
                   9794:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   9795:                     }
                   9796:                 }
                   9797:                 close($fh);
                   9798:             }
                   9799:         }
                   9800:         if ($env{'form.embedded_ref_'.$i}) {
                   9801:             $pathchange{$i} = 1;
                   9802:         }
                   9803:     }
                   9804:     if ($output) {
                   9805:         $output = '<p>'.$output.'</p>';
                   9806:     }
                   9807:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   9808:     $returnflag = 'ok';
1.1071    raeburn  9809:     my $numpathchgs = scalar(keys(%pathchange));
                   9810:     if ($numpathchgs > 0) {
1.987     raeburn  9811:         if ($context eq 'portfolio') {
                   9812:             $output .= '<p>'.&mt('or').'</p>';
                   9813:         } elsif ($context eq 'testbank') {
1.1071    raeburn  9814:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   9815:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  9816:             $returnflag = 'modify_orightml';
                   9817:         }
                   9818:     }
1.1071    raeburn  9819:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  9820: }
                   9821: 
                   9822: sub modify_html_form {
                   9823:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   9824:     my $end = 0;
                   9825:     my $modifyform;
                   9826:     if ($context eq 'upload_embedded') {
                   9827:         return unless (ref($pathchange) eq 'HASH');
                   9828:         if ($env{'form.number_embedded_items'}) {
                   9829:             $end += $env{'form.number_embedded_items'};
                   9830:         }
                   9831:         if ($env{'form.number_pathchange_items'}) {
                   9832:             $end += $env{'form.number_pathchange_items'};
                   9833:         }
                   9834:         if ($end) {
                   9835:             for (my $i=0; $i<$end; $i++) {
                   9836:                 if ($i < $env{'form.number_embedded_items'}) {
                   9837:                     next unless($pathchange->{$i});
                   9838:                 }
                   9839:                 $modifyform .=
                   9840:                     &start_data_table_row().
                   9841:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   9842:                     'checked="checked" /></td>'.
                   9843:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   9844:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   9845:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   9846:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   9847:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   9848:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   9849:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   9850:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   9851:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   9852:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   9853:                     &end_data_table_row();
1.1071    raeburn  9854:             }
1.987     raeburn  9855:         }
                   9856:     } else {
                   9857:         $modifyform = $pathchgtable;
                   9858:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   9859:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   9860:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   9861:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   9862:         }
                   9863:     }
                   9864:     if ($modifyform) {
1.1071    raeburn  9865:         if ($actionurl eq '/adm/dependencies') {
                   9866:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   9867:         }
1.987     raeburn  9868:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   9869:                '<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".
                   9870:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   9871:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   9872:                '</ol></p>'."\n".'<p>'.
                   9873:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   9874:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   9875:                &start_data_table()."\n".
                   9876:                &start_data_table_header_row().
                   9877:                '<th>'.&mt('Change?').'</th>'.
                   9878:                '<th>'.&mt('Current reference').'</th>'.
                   9879:                '<th>'.&mt('Required reference').'</th>'.
                   9880:                &end_data_table_header_row()."\n".
                   9881:                $modifyform.
                   9882:                &end_data_table().'<br />'."\n".$hiddenstate.
                   9883:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   9884:                '</form>'."\n";
                   9885:     }
                   9886:     return;
                   9887: }
                   9888: 
                   9889: sub modify_html_refs {
                   9890:     my ($context,$dirpath,$uname,$udom,$dir_root) = @_;
                   9891:     my $container;
                   9892:     if ($context eq 'portfolio') {
                   9893:         $container = $env{'form.container'};
                   9894:     } elsif ($context eq 'coursedoc') {
                   9895:         $container = $env{'form.primaryurl'};
1.1071    raeburn  9896:     } elsif ($context eq 'manage_dependencies') {
                   9897:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   9898:         $container = "/$container";
1.987     raeburn  9899:     } else {
1.1027    raeburn  9900:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  9901:     }
                   9902:     my (%allfiles,%codebase,$output,$content);
                   9903:     my @changes = &get_env_multiple('form.namechange');
1.1071    raeburn  9904:     unless (@changes > 0) {
                   9905:         if (wantarray) {
                   9906:             return ('',0,0); 
                   9907:         } else {
                   9908:             return;
                   9909:         }
                   9910:     }
                   9911:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   9912:         ($context eq 'manage_dependencies')) {
                   9913:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   9914:             if (wantarray) {
                   9915:                 return ('',0,0);
                   9916:             } else {
                   9917:                 return;
                   9918:             }
                   9919:         } 
1.987     raeburn  9920:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  9921:         if ($content eq '-1') {
                   9922:             if (wantarray) {
                   9923:                 return ('',0,0);
                   9924:             } else {
                   9925:                 return;
                   9926:             }
                   9927:         }
1.987     raeburn  9928:     } else {
1.1071    raeburn  9929:         unless ($container =~ /^\Q$dir_root\E/) {
                   9930:             if (wantarray) {
                   9931:                 return ('',0,0);
                   9932:             } else {
                   9933:                 return;
                   9934:             }
                   9935:         } 
1.987     raeburn  9936:         if (open(my $fh,"<$container")) {
                   9937:             $content = join('', <$fh>);
                   9938:             close($fh);
                   9939:         } else {
1.1071    raeburn  9940:             if (wantarray) {
                   9941:                 return ('',0,0);
                   9942:             } else {
                   9943:                 return;
                   9944:             }
1.987     raeburn  9945:         }
                   9946:     }
                   9947:     my ($count,$codebasecount) = (0,0);
                   9948:     my $mm = new File::MMagic;
                   9949:     my $mime_type = $mm->checktype_contents($content);
                   9950:     if ($mime_type eq 'text/html') {
                   9951:         my $parse_result = 
                   9952:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   9953:                                                     \%codebase,\$content);
                   9954:         if ($parse_result eq 'ok') {
                   9955:             foreach my $i (@changes) {
                   9956:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   9957:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   9958:                 if ($allfiles{$ref}) {
                   9959:                     my $newname =  $orig;
                   9960:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  9961:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  9962:                     if ($attrib_regexp =~ /:/) {
                   9963:                         $attrib_regexp =~ s/\:/|/g;
                   9964:                     }
                   9965:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   9966:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   9967:                         $count += $numchg;
                   9968:                     }
                   9969:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  9970:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  9971:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   9972:                         $codebasecount ++;
                   9973:                     }
                   9974:                 }
                   9975:             }
                   9976:             if ($count || $codebasecount) {
                   9977:                 my $saveresult;
1.1071    raeburn  9978:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
                   9979:                     ($context eq 'manage_dependencies')) {
1.987     raeburn  9980:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   9981:                     if ($url eq $container) {
                   9982:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   9983:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   9984:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  9985:                                             $fname.'</span>').'</p>';
1.987     raeburn  9986:                     } else {
                   9987:                          $output = '<p class="LC_error">'.
                   9988:                                    &mt('Error: update failed for: [_1].',
                   9989:                                    '<span class="LC_filename">'.
                   9990:                                    $container.'</span>').'</p>';
                   9991:                     }
                   9992:                 } else {
                   9993:                     if (open(my $fh,">$container")) {
                   9994:                         print $fh $content;
                   9995:                         close($fh);
                   9996:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   9997:                                   $count,'<span class="LC_filename">'.
                   9998:                                   $container.'</span>').'</p>';
1.661     raeburn  9999:                     } else {
1.987     raeburn  10000:                          $output = '<p class="LC_error">'.
                   10001:                                    &mt('Error: could not update [_1].',
                   10002:                                    '<span class="LC_filename">'.
                   10003:                                    $container.'</span>').'</p>';
1.661     raeburn  10004:                     }
                   10005:                 }
                   10006:             }
1.987     raeburn  10007:         } else {
                   10008:             &logthis('Failed to parse '.$container.
                   10009:                      ' to modify references: '.$parse_result);
1.661     raeburn  10010:         }
                   10011:     }
1.1071    raeburn  10012:     if (wantarray) {
                   10013:         return ($output,$count,$codebasecount);
                   10014:     } else {
                   10015:         return $output;
                   10016:     }
1.661     raeburn  10017: }
                   10018: 
                   10019: sub check_for_existing {
                   10020:     my ($path,$fname,$element) = @_;
                   10021:     my ($state,$msg);
                   10022:     if (-d $path.'/'.$fname) {
                   10023:         $state = 'exists';
                   10024:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10025:     } elsif (-e $path.'/'.$fname) {
                   10026:         $state = 'exists';
                   10027:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10028:     }
                   10029:     if ($state eq 'exists') {
                   10030:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10031:     }
                   10032:     return ($state,$msg);
                   10033: }
                   10034: 
                   10035: sub check_for_upload {
                   10036:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10037:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10038:     my $filesize = length($env{'form.'.$element});
                   10039:     if (!$filesize) {
                   10040:         my $msg = '<span class="LC_error">'.
                   10041:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10042:                       '<span class="LC_filename">'.$fname.'</span>',
                   10043:                       $filesize).'<br />'.
1.1007    raeburn  10044:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10045:                   '</span>';
                   10046:         return ('zero_bytes',$msg);
                   10047:     }
                   10048:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10049:     my $getpropath = 1;
1.1021    raeburn  10050:     my ($dirlistref,$listerror) =
                   10051:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10052:     my $found_file = 0;
                   10053:     my $locked_file = 0;
1.991     raeburn  10054:     my @lockers;
                   10055:     my $navmap;
                   10056:     if ($env{'request.course.id'}) {
                   10057:         $navmap = Apache::lonnavmaps::navmap->new();
                   10058:     }
1.1021    raeburn  10059:     if (ref($dirlistref) eq 'ARRAY') {
                   10060:         foreach my $line (@{$dirlistref}) {
                   10061:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10062:             if ($file_name eq $fname){
                   10063:                 $file_name = $path.$file_name;
                   10064:                 if ($group ne '') {
                   10065:                     $file_name = $group.$file_name;
                   10066:                 }
                   10067:                 $found_file = 1;
                   10068:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10069:                     foreach my $lock (@lockers) {
                   10070:                         if (ref($lock) eq 'ARRAY') {
                   10071:                             my ($symb,$crsid) = @{$lock};
                   10072:                             if ($crsid eq $env{'request.course.id'}) {
                   10073:                                 if (ref($navmap)) {
                   10074:                                     my $res = $navmap->getBySymb($symb);
                   10075:                                     foreach my $part (@{$res->parts()}) { 
                   10076:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10077:                                         unless (($slot_status == $res->RESERVED) ||
                   10078:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10079:                                             $locked_file = 1;
                   10080:                                         }
1.991     raeburn  10081:                                     }
1.1021    raeburn  10082:                                 } else {
                   10083:                                     $locked_file = 1;
1.991     raeburn  10084:                                 }
                   10085:                             } else {
                   10086:                                 $locked_file = 1;
                   10087:                             }
                   10088:                         }
1.1021    raeburn  10089:                    }
                   10090:                 } else {
                   10091:                     my @info = split(/\&/,$rest);
                   10092:                     my $currsize = $info[6]/1000;
                   10093:                     if ($currsize < $filesize) {
                   10094:                         my $extra = $filesize - $currsize;
                   10095:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   10096:                             my $msg = '<span class="LC_error">'.
                   10097:                                       &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.',
                   10098:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   10099:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10100:                                                    $disk_quota,$current_disk_usage);
                   10101:                             return ('will_exceed_quota',$msg);
                   10102:                         }
1.984     raeburn  10103:                     }
                   10104:                 }
1.661     raeburn  10105:             }
                   10106:         }
                   10107:     }
                   10108:     if (($current_disk_usage + $filesize) > $disk_quota){
                   10109:         my $msg = '<span class="LC_error">'.
                   10110:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   10111:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   10112:         return ('will_exceed_quota',$msg);
                   10113:     } elsif ($found_file) {
                   10114:         if ($locked_file) {
                   10115:             my $msg = '<span class="LC_error">';
                   10116:             $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>');
                   10117:             $msg .= '</span><br />';
                   10118:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10119:             return ('file_locked',$msg);
                   10120:         } else {
                   10121:             my $msg = '<span class="LC_error">';
1.984     raeburn  10122:             $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  10123:             $msg .= '</span>';
1.984     raeburn  10124:             return ('existingfile',$msg);
1.661     raeburn  10125:         }
                   10126:     }
                   10127: }
                   10128: 
1.987     raeburn  10129: sub check_for_traversal {
                   10130:     my ($path,$url,$toplevel) = @_;
                   10131:     my @parts=split(/\//,$path);
                   10132:     my $cleanpath;
                   10133:     my $fullpath = $url;
                   10134:     for (my $i=0;$i<@parts;$i++) {
                   10135:         next if ($parts[$i] eq '.');
                   10136:         if ($parts[$i] eq '..') {
                   10137:             $fullpath =~ s{([^/]+/)$}{};
                   10138:         } else {
                   10139:             $fullpath .= $parts[$i].'/';
                   10140:         }
                   10141:     }
                   10142:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10143:         $cleanpath = $1;
                   10144:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10145:         my $curr_toprel = $1;
                   10146:         my @parts = split(/\//,$curr_toprel);
                   10147:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10148:         my @urlparts = split(/\//,$url_toprel);
                   10149:         my $doubledots;
                   10150:         my $startdiff = -1;
                   10151:         for (my $i=0; $i<@urlparts; $i++) {
                   10152:             if ($startdiff == -1) {
                   10153:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10154:                     $startdiff = $i;
                   10155:                     $doubledots .= '../';
                   10156:                 }
                   10157:             } else {
                   10158:                 $doubledots .= '../';
                   10159:             }
                   10160:         }
                   10161:         if ($startdiff > -1) {
                   10162:             $cleanpath = $doubledots;
                   10163:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10164:                 $cleanpath .= $parts[$i].'/';
                   10165:             }
                   10166:         }
                   10167:     }
                   10168:     $cleanpath =~ s{(/)$}{};
                   10169:     return $cleanpath;
                   10170: }
1.31      albertel 10171: 
1.1053    raeburn  10172: sub is_archive_file {
                   10173:     my ($mimetype) = @_;
                   10174:     if (($mimetype eq 'application/octet-stream') ||
                   10175:         ($mimetype eq 'application/x-stuffit') ||
                   10176:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   10177:         return 1;
                   10178:     }
                   10179:     return;
                   10180: }
                   10181: 
                   10182: sub decompress_form {
1.1065    raeburn  10183:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  10184:     my %lt = &Apache::lonlocal::texthash (
                   10185:         this => 'This file is an archive file.',
1.1067    raeburn  10186:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  10187:         itsc => 'Its contents are as follows:',
1.1053    raeburn  10188:         youm => 'You may wish to extract its contents.',
                   10189:         extr => 'Extract contents',
1.1067    raeburn  10190:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   10191:         proa => 'Process automatically?',
1.1053    raeburn  10192:         yes  => 'Yes',
                   10193:         no   => 'No',
1.1067    raeburn  10194:         fold => 'Title for folder containing movie',
                   10195:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  10196:     );
1.1065    raeburn  10197:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  10198:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  10199:     my $info = &list_archive_contents($fileloc,\@paths);
                   10200:     if (@paths) {
                   10201:         foreach my $path (@paths) {
                   10202:             $path =~ s{^/}{};
1.1067    raeburn  10203:             if ($path =~ m{^([^/]+)/$}) {
                   10204:                 $topdir = $1;
                   10205:             }
1.1065    raeburn  10206:             if ($path =~ m{^([^/]+)/}) {
                   10207:                 $toplevel{$1} = $path;
                   10208:             } else {
                   10209:                 $toplevel{$path} = $path;
                   10210:             }
                   10211:         }
                   10212:     }
1.1067    raeburn  10213:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
                   10214:         my @camtasia = ("$topdir/","$topdir/index.html",
                   10215:                         "$topdir/media/",
                   10216:                         "$topdir/media/$topdir.mp4",
                   10217:                         "$topdir/media/FirstFrame.png",
                   10218:                         "$topdir/media/player.swf",
                   10219:                         "$topdir/media/swfobject.js",
                   10220:                         "$topdir/media/expressInstall.swf");
                   10221:         my @diffs = &compare_arrays(\@paths,\@camtasia);
                   10222:         if (@diffs == 0) {
                   10223:             $is_camtasia = 1;
                   10224:         }
                   10225:     }
                   10226:     my $output;
                   10227:     if ($is_camtasia) {
                   10228:         $output = <<"ENDCAM";
                   10229: <script type="text/javascript" language="Javascript">
                   10230: // <![CDATA[
                   10231: 
                   10232: function camtasiaToggle() {
                   10233:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   10234:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
                   10235:             if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
                   10236: 
                   10237:                 document.getElementById('camtasia_titles').style.display='block';
                   10238:             } else {
                   10239:                 document.getElementById('camtasia_titles').style.display='none';
                   10240:             }
                   10241:         }
                   10242:     }
                   10243:     return;
                   10244: }
                   10245: 
                   10246: // ]]>
                   10247: </script>
                   10248: <p>$lt{'camt'}</p>
                   10249: ENDCAM
1.1065    raeburn  10250:     } else {
1.1067    raeburn  10251:         $output = '<p>'.$lt{'this'};
                   10252:         if ($info eq '') {
                   10253:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   10254:         } else {
                   10255:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   10256:                        '<div><pre>'.$info.'</pre></div>';
                   10257:         }
1.1065    raeburn  10258:     }
1.1067    raeburn  10259:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  10260:     my $duplicates;
                   10261:     my $num = 0;
                   10262:     if (ref($dirlist) eq 'ARRAY') {
                   10263:         foreach my $item (@{$dirlist}) {
                   10264:             if (ref($item) eq 'ARRAY') {
                   10265:                 if (exists($toplevel{$item->[0]})) {
                   10266:                     $duplicates .= 
                   10267:                         &start_data_table_row().
                   10268:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10269:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   10270:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   10271:                         'value="1" />'.&mt('Yes').'</label>'.
                   10272:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   10273:                         '<td>'.$item->[0].'</td>';
                   10274:                     if ($item->[2]) {
                   10275:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   10276:                     } else {
                   10277:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   10278:                     }
                   10279:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   10280:                                    '<td>'.
                   10281:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   10282:                                    '</td>'.
                   10283:                                    &end_data_table_row();
                   10284:                     $num ++;
                   10285:                 }
                   10286:             }
                   10287:         }
                   10288:     }
                   10289:     my $itemcount;
                   10290:     if (@paths > 0) {
                   10291:         $itemcount = scalar(@paths);
                   10292:     } else {
                   10293:         $itemcount = 1;
                   10294:     }
1.1067    raeburn  10295:     if ($is_camtasia) {
                   10296:         $output .= $lt{'auto'}.'<br />'.
                   10297:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                   10298:                    '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                   10299:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   10300:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   10301:                    $lt{'no'}.'</label></span><br />'.
                   10302:                    '<div id="camtasia_titles" style="display:block">'.
                   10303:                    &Apache::lonhtmlcommon::start_pick_box().
                   10304:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   10305:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   10306:                    &Apache::lonhtmlcommon::row_closure().
                   10307:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   10308:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   10309:                    &Apache::lonhtmlcommon::row_closure(1).
                   10310:                    &Apache::lonhtmlcommon::end_pick_box().
                   10311:                    '</div>';
                   10312:     }
1.1065    raeburn  10313:     $output .= 
                   10314:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  10315:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   10316:         "\n";
1.1065    raeburn  10317:     if ($duplicates ne '') {
                   10318:         $output .= '<p><span class="LC_warning">'.
                   10319:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   10320:                    &start_data_table().
                   10321:                    &start_data_table_header_row().
                   10322:                    '<th>'.&mt('Overwrite?').'</th>'.
                   10323:                    '<th>'.&mt('Name').'</th>'.
                   10324:                    '<th>'.&mt('Type').'</th>'.
                   10325:                    '<th>'.&mt('Size').'</th>'.
                   10326:                    '<th>'.&mt('Last modified').'</th>'.
                   10327:                    &end_data_table_header_row().
                   10328:                    $duplicates.
                   10329:                    &end_data_table().
                   10330:                    '</p>';
                   10331:     }
1.1067    raeburn  10332:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  10333:     if (ref($hiddenelements) eq 'HASH') {
                   10334:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   10335:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   10336:         }
                   10337:     }
                   10338:     $output .= <<"END";
1.1067    raeburn  10339: <br />
1.1053    raeburn  10340: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   10341: </form>
                   10342: $noextract
                   10343: END
                   10344:     return $output;
                   10345: }
                   10346: 
1.1065    raeburn  10347: sub decompression_utility {
                   10348:     my ($program) = @_;
                   10349:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   10350:     my $location;
                   10351:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   10352:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   10353:                          '/usr/sbin/') {
                   10354:             if (-x $dir.$program) {
                   10355:                 $location = $dir.$program;
                   10356:                 last;
                   10357:             }
                   10358:         }
                   10359:     }
                   10360:     return $location;
                   10361: }
                   10362: 
                   10363: sub list_archive_contents {
                   10364:     my ($file,$pathsref) = @_;
                   10365:     my (@cmd,$output);
                   10366:     my $needsregexp;
                   10367:     if ($file =~ /\.zip$/) {
                   10368:         @cmd = (&decompression_utility('unzip'),"-l");
                   10369:         $needsregexp = 1;
                   10370:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   10371:              ($file =~ /\.tgz$/)) {
                   10372:         @cmd = (&decompression_utility('tar'),"-ztf");
                   10373:     } elsif ($file =~ /\.tar\.bz2$/) {
                   10374:         @cmd = (&decompression_utility('tar'),"-jtf");
                   10375:     } elsif ($file =~ m|\.tar$|) {
                   10376:         @cmd = (&decompression_utility('tar'),"-tf");
                   10377:     }
                   10378:     if (@cmd) {
                   10379:         undef($!);
                   10380:         undef($@);
                   10381:         if (open(my $fh,"-|", @cmd, $file)) {
                   10382:             while (my $line = <$fh>) {
                   10383:                 $output .= $line;
                   10384:                 chomp($line);
                   10385:                 my $item;
                   10386:                 if ($needsregexp) {
                   10387:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   10388:                 } else {
                   10389:                     $item = $line;
                   10390:                 }
                   10391:                 if ($item ne '') {
                   10392:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   10393:                         push(@{$pathsref},$item);
                   10394:                     } 
                   10395:                 }
                   10396:             }
                   10397:             close($fh);
                   10398:         }
                   10399:     }
                   10400:     return $output;
                   10401: }
                   10402: 
1.1053    raeburn  10403: sub decompress_uploaded_file {
                   10404:     my ($file,$dir) = @_;
                   10405:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   10406:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   10407:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   10408:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   10409:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   10410:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   10411:     my $decompressed = $env{'cgi.decompressed'};
                   10412:     &Apache::lonnet::delenv('cgi.file');
                   10413:     &Apache::lonnet::delenv('cgi.dir');
                   10414:     &Apache::lonnet::delenv('cgi.decompressed');
                   10415:     return ($decompressed,$result);
                   10416: }
                   10417: 
1.1055    raeburn  10418: sub process_decompression {
                   10419:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   10420:     my ($dir,$error,$warning,$output);
                   10421:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
                   10422:         $error = &mt('File name not a supported archive file type.').
                   10423:                  '<br />'.&mt('File name should end with one of: [_1].',
                   10424:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   10425:     } else {
                   10426:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   10427:         if ($docuhome eq 'no_host') {
                   10428:             $error = &mt('Could not determine home server for course.');
                   10429:         } else {
                   10430:             my @ids=&Apache::lonnet::current_machine_ids();
                   10431:             my $currdir = "$dir_root/$destination";
                   10432:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   10433:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   10434:                        "$dir_root/$destination";
                   10435:             } else {
                   10436:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   10437:                        "$dir_root/$docudom/$docuname/$destination";
                   10438:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   10439:                     $error = &mt('Archive file not found.');
                   10440:                 }
                   10441:             }
1.1065    raeburn  10442:             my (@to_overwrite,@to_skip);
                   10443:             if ($env{'form.archive_overwrite_total'} > 0) {
                   10444:                 my $total = $env{'form.archive_overwrite_total'};
                   10445:                 for (my $i=0; $i<$total; $i++) {
                   10446:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   10447:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   10448:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   10449:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   10450:                     }
                   10451:                 }
                   10452:             }
                   10453:             my $numskip = scalar(@to_skip);
                   10454:             if (($numskip > 0) && 
                   10455:                 ($numskip == $env{'form.archive_itemcount'})) {
                   10456:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   10457:             } elsif ($dir eq '') {
1.1055    raeburn  10458:                 $error = &mt('Directory containing archive file unavailable.');
                   10459:             } elsif (!$error) {
1.1065    raeburn  10460:                 my ($decompressed,$display);
                   10461:                 if ($numskip > 0) {
                   10462:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   10463:                     mkdir("$dir/$tempdir",0755);
                   10464:                     system("mv $dir/$file $dir/$tempdir/$file");
                   10465:                     ($decompressed,$display) = 
                   10466:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   10467:                     foreach my $item (@to_skip) {
                   10468:                         if (($item ne '') && ($item !~ /\.\./)) {
                   10469:                             if (-f "$dir/$tempdir/$item") { 
                   10470:                                 unlink("$dir/$tempdir/$item");
                   10471:                             } elsif (-d "$dir/$tempdir/$item") {
                   10472:                                 system("rm -rf $dir/$tempdir/$item");
                   10473:                             }
                   10474:                         }
                   10475:                     }
                   10476:                     system("mv $dir/$tempdir/* $dir");
                   10477:                     rmdir("$dir/$tempdir");   
                   10478:                 } else {
                   10479:                     ($decompressed,$display) = 
                   10480:                         &decompress_uploaded_file($file,$dir);
                   10481:                 }
1.1055    raeburn  10482:                 if ($decompressed eq 'ok') {
1.1065    raeburn  10483:                     $output = '<p class="LC_info">'.
                   10484:                               &mt('Files extracted successfully from archive.').
                   10485:                               '</p>'."\n";
1.1055    raeburn  10486:                     my ($warning,$result,@contents);
                   10487:                     my ($newdirlistref,$newlisterror) =
                   10488:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   10489:                                                  $docuname,1);
                   10490:                     my (%is_dir,%changes,@newitems);
                   10491:                     my $dirptr = 16384;
1.1065    raeburn  10492:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  10493:                         foreach my $dir_line (@{$newdirlistref}) {
                   10494:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  10495:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   10496:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  10497:                                 push(@newitems,$item);
                   10498:                                 if ($dirptr&$testdir) {
                   10499:                                     $is_dir{$item} = 1;
                   10500:                                 }
                   10501:                                 $changes{$item} = 1;
                   10502:                             }
                   10503:                         }
                   10504:                     }
                   10505:                     if (keys(%changes) > 0) {
                   10506:                         foreach my $item (sort(@newitems)) {
                   10507:                             if ($changes{$item}) {
                   10508:                                 push(@contents,$item);
                   10509:                             }
                   10510:                         }
                   10511:                     }
                   10512:                     if (@contents > 0) {
1.1067    raeburn  10513:                         my $wantform;
                   10514:                         unless ($env{'form.autoextract_camtasia'}) {
                   10515:                             $wantform = 1;
                   10516:                         }
1.1056    raeburn  10517:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  10518:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   10519:                                                                 $currdir,\%is_dir,
                   10520:                                                                 \%children,\%parent,
1.1056    raeburn  10521:                                                                 \@contents,\%dirorder,
                   10522:                                                                 \%titles,$wantform);
1.1055    raeburn  10523:                         if ($datatable ne '') {
                   10524:                             $output .= &archive_options_form('decompressed',$datatable,
                   10525:                                                              $count,$hiddenelem);
1.1065    raeburn  10526:                             my $startcount = 6;
1.1055    raeburn  10527:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  10528:                                                            \%titles,\%children);
1.1055    raeburn  10529:                         }
1.1067    raeburn  10530:                         if ($env{'form.autoextract_camtasia'}) {
                   10531:                             my %displayed;
                   10532:                             my $total = 1;
                   10533:                             $env{'form.archive_directory'} = [];
                   10534:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   10535:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   10536:                                 $path =~ s{/$}{};
                   10537:                                 my $item;
                   10538:                                 if ($path ne '') {
                   10539:                                     $item = "$path/$titles{$i}";
                   10540:                                 } else {
                   10541:                                     $item = $titles{$i};
                   10542:                                 }
                   10543:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   10544:                                 if ($item eq $contents[0]) {
                   10545:                                     push(@{$env{'form.archive_directory'}},$i);
                   10546:                                     $env{'form.archive_'.$i} = 'display';
                   10547:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   10548:                                     $displayed{'folder'} = $i;
                   10549:                                 } elsif ($item eq "$contents[0]/index.html") {
                   10550:                                     $env{'form.archive_'.$i} = 'display';
                   10551:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   10552:                                     $displayed{'web'} = $i;
                   10553:                                 } else {
                   10554:                                     if ($item eq "$contents[0]/media") {
                   10555:                                         push(@{$env{'form.archive_directory'}},$i);
                   10556:                                     }
                   10557:                                     $env{'form.archive_'.$i} = 'dependency';
                   10558:                                 }
                   10559:                                 $total ++;
                   10560:                             }
                   10561:                             for (my $i=1; $i<$total; $i++) {
                   10562:                                 next if ($i == $displayed{'web'});
                   10563:                                 next if ($i == $displayed{'folder'});
                   10564:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   10565:                             }
                   10566:                             $env{'form.phase'} = 'decompress_cleanup';
                   10567:                             $env{'form.archivedelete'} = 1;
                   10568:                             $env{'form.archive_count'} = $total-1;
                   10569:                             $output .=
                   10570:                                 &process_extracted_files('coursedocs',$docudom,
                   10571:                                                          $docuname,$destination,
                   10572:                                                          $dir_root,$hiddenelem);
                   10573:                         }
1.1055    raeburn  10574:                     } else {
                   10575:                         $warning = &mt('No new items extracted from archive file.');
                   10576:                     }
                   10577:                 } else {
                   10578:                     $output = $display;
                   10579:                     $error = &mt('An error occurred during extraction from the archive file.');
                   10580:                 }
                   10581:             }
                   10582:         }
                   10583:     }
                   10584:     if ($error) {
                   10585:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   10586:                    $error.'</p>'."\n";
                   10587:     }
                   10588:     if ($warning) {
                   10589:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   10590:     }
                   10591:     return $output;
                   10592: }
                   10593: 
                   10594: sub get_extracted {
1.1056    raeburn  10595:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   10596:         $titles,$wantform) = @_;
1.1055    raeburn  10597:     my $count = 0;
                   10598:     my $depth = 0;
                   10599:     my $datatable;
1.1056    raeburn  10600:     my @hierarchy;
1.1055    raeburn  10601:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  10602:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   10603:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  10604:     foreach my $item (@{$contents}) {
                   10605:         $count ++;
1.1056    raeburn  10606:         @{$dirorder->{$count}} = @hierarchy;
                   10607:         $titles->{$count} = $item;
1.1055    raeburn  10608:         &archive_hierarchy($depth,$count,$parent,$children);
                   10609:         if ($wantform) {
                   10610:             $datatable .= &archive_row($is_dir->{$item},$item,
                   10611:                                        $currdir,$depth,$count);
                   10612:         }
                   10613:         if ($is_dir->{$item}) {
                   10614:             $depth ++;
1.1056    raeburn  10615:             push(@hierarchy,$count);
                   10616:             $parent->{$depth} = $count;
1.1055    raeburn  10617:             $datatable .=
                   10618:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  10619:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   10620:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  10621:             $depth --;
1.1056    raeburn  10622:             pop(@hierarchy);
1.1055    raeburn  10623:         }
                   10624:     }
                   10625:     return ($count,$datatable);
                   10626: }
                   10627: 
                   10628: sub recurse_extracted_archive {
1.1056    raeburn  10629:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   10630:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  10631:     my $result='';
1.1056    raeburn  10632:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   10633:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   10634:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  10635:         return $result;
                   10636:     }
                   10637:     my $dirptr = 16384;
                   10638:     my ($newdirlistref,$newlisterror) =
                   10639:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   10640:     if (ref($newdirlistref) eq 'ARRAY') {
                   10641:         foreach my $dir_line (@{$newdirlistref}) {
                   10642:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   10643:             unless ($item =~ /^\.+$/) {
                   10644:                 $$count ++;
1.1056    raeburn  10645:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   10646:                 $titles->{$$count} = $item;
1.1055    raeburn  10647:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  10648: 
1.1055    raeburn  10649:                 my $is_dir;
                   10650:                 if ($dirptr&$testdir) {
                   10651:                     $is_dir = 1;
                   10652:                 }
                   10653:                 if ($wantform) {
                   10654:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   10655:                 }
                   10656:                 if ($is_dir) {
                   10657:                     $$depth ++;
1.1056    raeburn  10658:                     push(@{$hierarchy},$$count);
                   10659:                     $parent->{$$depth} = $$count;
1.1055    raeburn  10660:                     $result .=
                   10661:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   10662:                                                    $docuname,$depth,$count,
1.1056    raeburn  10663:                                                    $hierarchy,$dirorder,$children,
                   10664:                                                    $parent,$titles,$wantform);
1.1055    raeburn  10665:                     $$depth --;
1.1056    raeburn  10666:                     pop(@{$hierarchy});
1.1055    raeburn  10667:                 }
                   10668:             }
                   10669:         }
                   10670:     }
                   10671:     return $result;
                   10672: }
                   10673: 
                   10674: sub archive_hierarchy {
                   10675:     my ($depth,$count,$parent,$children) =@_;
                   10676:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   10677:         if (exists($parent->{$depth})) {
                   10678:              $children->{$parent->{$depth}} .= $count.':';
                   10679:         }
                   10680:     }
                   10681:     return;
                   10682: }
                   10683: 
                   10684: sub archive_row {
                   10685:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   10686:     my ($name) = ($item =~ m{([^/]+)$});
                   10687:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  10688:                                        'display'    => 'Add as file',
1.1055    raeburn  10689:                                        'dependency' => 'Include as dependency',
                   10690:                                        'discard'    => 'Discard',
                   10691:                                       );
                   10692:     if ($is_dir) {
1.1059    raeburn  10693:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  10694:     }
1.1056    raeburn  10695:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   10696:     my $offset = 0;
1.1055    raeburn  10697:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  10698:         $offset ++;
1.1065    raeburn  10699:         if ($action ne 'display') {
                   10700:             $offset ++;
                   10701:         }  
1.1055    raeburn  10702:         $output .= '<td><span class="LC_nobreak">'.
                   10703:                    '<label><input type="radio" name="archive_'.$count.
                   10704:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   10705:         my $text = $choices{$action};
                   10706:         if ($is_dir) {
                   10707:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   10708:             if ($action eq 'display') {
1.1059    raeburn  10709:                 $text = &mt('Add as folder');
1.1055    raeburn  10710:             }
1.1056    raeburn  10711:         } else {
                   10712:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   10713: 
                   10714:         }
                   10715:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   10716:         if ($action eq 'dependency') {
                   10717:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   10718:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   10719:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   10720:                        '<option value=""></option>'."\n".
                   10721:                        '</select>'."\n".
                   10722:                        '</div>';
1.1059    raeburn  10723:         } elsif ($action eq 'display') {
                   10724:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   10725:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   10726:                        '</div>';
1.1055    raeburn  10727:         }
1.1056    raeburn  10728:         $output .= '</td>';
1.1055    raeburn  10729:     }
                   10730:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   10731:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   10732:     for (my $i=0; $i<$depth; $i++) {
                   10733:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   10734:     }
                   10735:     if ($is_dir) {
                   10736:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   10737:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   10738:     } else {
                   10739:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   10740:     }
                   10741:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   10742:                &end_data_table_row();
                   10743:     return $output;
                   10744: }
                   10745: 
                   10746: sub archive_options_form {
1.1065    raeburn  10747:     my ($form,$display,$count,$hiddenelem) = @_;
                   10748:     my %lt = &Apache::lonlocal::texthash(
                   10749:                perm => 'Permanently remove archive file?',
                   10750:                hows => 'How should each extracted item be incorporated in the course?',
                   10751:                cont => 'Content actions for all',
                   10752:                addf => 'Add as folder/file',
                   10753:                incd => 'Include as dependency for a displayed file',
                   10754:                disc => 'Discard',
                   10755:                no   => 'No',
                   10756:                yes  => 'Yes',
                   10757:                save => 'Save',
                   10758:     );
                   10759:     my $output = <<"END";
                   10760: <form name="$form" method="post" action="">
                   10761: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   10762: <label>
                   10763:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   10764: </label>
                   10765: &nbsp;
                   10766: <label>
                   10767:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   10768: </span>
                   10769: </p>
                   10770: <input type="hidden" name="phase" value="decompress_cleanup" />
                   10771: <br />$lt{'hows'}
                   10772: <div class="LC_columnSection">
                   10773:   <fieldset>
                   10774:     <legend>$lt{'cont'}</legend>
                   10775:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   10776:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   10777:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   10778:   </fieldset>
                   10779: </div>
                   10780: END
                   10781:     return $output.
1.1055    raeburn  10782:            &start_data_table()."\n".
1.1065    raeburn  10783:            $display."\n".
1.1055    raeburn  10784:            &end_data_table()."\n".
                   10785:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   10786:            $hiddenelem.
1.1065    raeburn  10787:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  10788:            '</form>';
                   10789: }
                   10790: 
                   10791: sub archive_javascript {
1.1056    raeburn  10792:     my ($startcount,$numitems,$titles,$children) = @_;
                   10793:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  10794:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  10795:     my $scripttag = <<START;
                   10796: <script type="text/javascript">
                   10797: // <![CDATA[
                   10798: 
                   10799: function checkAll(form,prefix) {
                   10800:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   10801:     for (var i=0; i < form.elements.length; i++) {
                   10802:         var id = form.elements[i].id;
                   10803:         if ((id != '') && (id != undefined)) {
                   10804:             if (idstr.test(id)) {
                   10805:                 if (form.elements[i].type == 'radio') {
                   10806:                     form.elements[i].checked = true;
1.1056    raeburn  10807:                     var nostart = i-$startcount;
1.1059    raeburn  10808:                     var offset = nostart%7;
                   10809:                     var count = (nostart-offset)/7;    
1.1056    raeburn  10810:                     dependencyCheck(form,count,offset);
1.1055    raeburn  10811:                 }
                   10812:             }
                   10813:         }
                   10814:     }
                   10815: }
                   10816: 
                   10817: function propagateCheck(form,count) {
                   10818:     if (count > 0) {
1.1059    raeburn  10819:         var startelement = $startcount + ((count-1) * 7);
                   10820:         for (var j=1; j<6; j++) {
                   10821:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  10822:                 var item = startelement + j; 
                   10823:                 if (form.elements[item].type == 'radio') {
                   10824:                     if (form.elements[item].checked) {
                   10825:                         containerCheck(form,count,j);
                   10826:                         break;
                   10827:                     }
1.1055    raeburn  10828:                 }
                   10829:             }
                   10830:         }
                   10831:     }
                   10832: }
                   10833: 
                   10834: numitems = $numitems
1.1056    raeburn  10835: var titles = new Array(numitems);
                   10836: var parents = new Array(numitems);
1.1055    raeburn  10837: for (var i=0; i<numitems; i++) {
1.1056    raeburn  10838:     parents[i] = new Array;
1.1055    raeburn  10839: }
1.1059    raeburn  10840: var maintitle = '$maintitle';
1.1055    raeburn  10841: 
                   10842: START
                   10843: 
1.1056    raeburn  10844:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   10845:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  10846:         for (my $i=0; $i<@contents; $i ++) {
                   10847:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   10848:         }
                   10849:     }
                   10850: 
1.1056    raeburn  10851:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   10852:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   10853:     }
                   10854: 
1.1055    raeburn  10855:     $scripttag .= <<END;
                   10856: 
                   10857: function containerCheck(form,count,offset) {
                   10858:     if (count > 0) {
1.1056    raeburn  10859:         dependencyCheck(form,count,offset);
1.1059    raeburn  10860:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  10861:         form.elements[item].checked = true;
                   10862:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   10863:             if (parents[count].length > 0) {
                   10864:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  10865:                     containerCheck(form,parents[count][j],offset);
                   10866:                 }
                   10867:             }
                   10868:         }
                   10869:     }
                   10870: }
                   10871: 
                   10872: function dependencyCheck(form,count,offset) {
                   10873:     if (count > 0) {
1.1059    raeburn  10874:         var chosen = (offset+$startcount)+7*(count-1);
                   10875:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  10876:         var currtype = form.elements[depitem].type;
                   10877:         if (form.elements[chosen].value == 'dependency') {
                   10878:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   10879:             form.elements[depitem].options.length = 0;
                   10880:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   10881:             for (var i=1; i<count; i++) {
1.1059    raeburn  10882:                 var startelement = $startcount + (i-1) * 7;
                   10883:                 for (var j=1; j<6; j++) {
                   10884:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  10885:                         var item = startelement + j;
                   10886:                         if (form.elements[item].type == 'radio') {
                   10887:                             if (form.elements[item].checked) {
                   10888:                                 if (form.elements[item].value == 'display') {
                   10889:                                     var n = form.elements[depitem].options.length;
                   10890:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   10891:                                 }
                   10892:                             }
                   10893:                         }
                   10894:                     }
                   10895:                 }
                   10896:             }
                   10897:         } else {
                   10898:             document.getElementById('arc_depon_'+count).style.display='none';
                   10899:             form.elements[depitem].options.length = 0;
                   10900:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   10901:         }
1.1059    raeburn  10902:         titleCheck(form,count,offset);
1.1056    raeburn  10903:     }
                   10904: }
                   10905: 
                   10906: function propagateSelect(form,count,offset) {
                   10907:     if (count > 0) {
1.1065    raeburn  10908:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  10909:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   10910:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   10911:             if (parents[count].length > 0) {
                   10912:                 for (var j=0; j<parents[count].length; j++) {
                   10913:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  10914:                 }
                   10915:             }
                   10916:         }
                   10917:     }
                   10918: }
1.1056    raeburn  10919: 
                   10920: function containerSelect(form,count,offset,picked) {
                   10921:     if (count > 0) {
1.1065    raeburn  10922:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  10923:         if (form.elements[item].type == 'radio') {
                   10924:             if (form.elements[item].value == 'dependency') {
                   10925:                 if (form.elements[item+1].type == 'select-one') {
                   10926:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   10927:                         if (form.elements[item+1].options[i].value == picked) {
                   10928:                             form.elements[item+1].selectedIndex = i;
                   10929:                             break;
                   10930:                         }
                   10931:                     }
                   10932:                 }
                   10933:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   10934:                     if (parents[count].length > 0) {
                   10935:                         for (var j=0; j<parents[count].length; j++) {
                   10936:                             containerSelect(form,parents[count][j],offset,picked);
                   10937:                         }
                   10938:                     }
                   10939:                 }
                   10940:             }
                   10941:         }
                   10942:     }
                   10943: }
                   10944: 
1.1059    raeburn  10945: function titleCheck(form,count,offset) {
                   10946:     if (count > 0) {
                   10947:         var chosen = (offset+$startcount)+7*(count-1);
                   10948:         var depitem = $startcount + ((count-1) * 7) + 2;
                   10949:         var currtype = form.elements[depitem].type;
                   10950:         if (form.elements[chosen].value == 'display') {
                   10951:             document.getElementById('arc_title_'+count).style.display='block';
                   10952:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   10953:                 document.getElementById('archive_title_'+count).value=maintitle;
                   10954:             }
                   10955:         } else {
                   10956:             document.getElementById('arc_title_'+count).style.display='none';
                   10957:             if (currtype == 'text') { 
                   10958:                 document.getElementById('archive_title_'+count).value='';
                   10959:             }
                   10960:         }
                   10961:     }
                   10962:     return;
                   10963: }
                   10964: 
1.1055    raeburn  10965: // ]]>
                   10966: </script>
                   10967: END
                   10968:     return $scripttag;
                   10969: }
                   10970: 
                   10971: sub process_extracted_files {
1.1067    raeburn  10972:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  10973:     my $numitems = $env{'form.archive_count'};
                   10974:     return unless ($numitems);
                   10975:     my @ids=&Apache::lonnet::current_machine_ids();
                   10976:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  10977:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  10978:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   10979:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   10980:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   10981:         $pathtocheck = "$dir_root/$destination";
                   10982:         $dir = $dir_root;
                   10983:         $ishome = 1;
                   10984:     } else {
                   10985:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   10986:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   10987:         $dir = "$dir_root/$docudom/$docuname";    
                   10988:     }
                   10989:     my $currdir = "$dir_root/$destination";
                   10990:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   10991:     if ($env{'form.folderpath'}) {
                   10992:         my @items = split('&',$env{'form.folderpath'});
                   10993:         $folders{'0'} = $items[-2];
                   10994:         $containers{'0'}='sequence';
                   10995:     } elsif ($env{'form.pagepath'}) {
                   10996:         my @items = split('&',$env{'form.pagepath'});
                   10997:         $folders{'0'} = $items[-2];
                   10998:         $containers{'0'}='page';
                   10999:     }
                   11000:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11001:     if ($numitems) {
                   11002:         for (my $i=1; $i<=$numitems; $i++) {
                   11003:             my $path = $env{'form.archive_content_'.$i};
                   11004:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11005:                 my $item = $1;
                   11006:                 $toplevelitems{$item} = $i;
                   11007:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11008:                     $is_dir{$item} = 1;
                   11009:                 }
                   11010:             }
                   11011:         }
                   11012:     }
1.1067    raeburn  11013:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11014:     if (keys(%toplevelitems) > 0) {
                   11015:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11016:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11017:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11018:     }
1.1066    raeburn  11019:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11020:     if ($numitems) {
                   11021:         for (my $i=1; $i<=$numitems; $i++) {
                   11022:             my $path = $env{'form.archive_content_'.$i};
                   11023:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11024:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11025:                     if ($prefix ne '' && $path ne '') {
                   11026:                         if (-e $prefix.$path) {
1.1066    raeburn  11027:                             if ((@archdirs > 0) && 
                   11028:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11029:                                 $todeletedir{$prefix.$path} = 1;
                   11030:                             } else {
                   11031:                                 $todelete{$prefix.$path} = 1;
                   11032:                             }
1.1055    raeburn  11033:                         }
                   11034:                     }
                   11035:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11036:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11037:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11038:                     $docstitle = $env{'form.archive_title_'.$i};
                   11039:                     if ($docstitle eq '') {
                   11040:                         $docstitle = $title;
                   11041:                     }
1.1055    raeburn  11042:                     $outer = 0;
1.1056    raeburn  11043:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11044:                         if (@{$dirorder{$i}} > 0) {
                   11045:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11046:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11047:                                     $outer = $item;
                   11048:                                     last;
                   11049:                                 }
                   11050:                             }
                   11051:                         }
                   11052:                     }
                   11053:                     my ($errtext,$fatal) = 
                   11054:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11055:                                                '/'.$folders{$outer}.'.'.
                   11056:                                                $containers{$outer});
                   11057:                     next if ($fatal);
                   11058:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11059:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11060:                             $mapinner{$i} = time;
1.1055    raeburn  11061:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11062:                             $containers{$i} = 'sequence';
                   11063:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11064:                                       $folders{$i}.'.'.$containers{$i};
                   11065:                             my $newidx = &LONCAPA::map::getresidx();
                   11066:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11067:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11068:                             push(@LONCAPA::map::order,$newidx);
                   11069:                             my ($outtext,$errtext) =
                   11070:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11071:                                                         $docuname.'/'.$folders{$outer}.
                   11072:                                                         '.'.$containers{$outer},1);
1.1056    raeburn  11073:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11074:                             unless ($errtext) {
                   11075:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11076:                             }
1.1055    raeburn  11077:                         }
                   11078:                     } else {
                   11079:                         if ($context eq 'coursedocs') {
                   11080:                             my $newidx=&LONCAPA::map::getresidx();
                   11081:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11082:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11083:                                       $title;
                   11084:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11085:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11086:                             }
                   11087:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11088:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11089:                             }
                   11090:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11091:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11092:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11093:                                 unless ($ishome) {
                   11094:                                     my $fetch = "$newdest{$i}/$title";
                   11095:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11096:                                     $prompttofetch{$fetch} = 1;
                   11097:                                 }
1.1055    raeburn  11098:                             }
                   11099:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11100:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11101:                             push(@LONCAPA::map::order, $newidx);
                   11102:                             my ($outtext,$errtext)=
                   11103:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11104:                                                         $docuname.'/'.$folders{$outer}.
                   11105:                                                         '.'.$containers{$outer},1);
1.1067    raeburn  11106:                             unless ($errtext) {
                   11107:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11108:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11109:                                 }
                   11110:                             }
1.1055    raeburn  11111:                         }
                   11112:                     }
                   11113:                 } elsif ($env{'form.archive_'.$i} eq 'dependency') {
1.1056    raeburn  11114:                     my ($title) = ($path =~ m{/([^/]+)$});
                   11115:                     $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11116:                     if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11117:                         if (ref($dirorder{$i}) eq 'ARRAY') {
1.1067    raeburn  11118:                             my ($itemidx,$fullpath,$relpath);
1.1056    raeburn  11119:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
                   11120:                                 if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11121:                                     my $container = $dirorder{$referrer{$i}}->[-1];
                   11122:                                     for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
                   11123:                                         if ($dirorder{$i}->[$j] eq $container) {
                   11124:                                             $itemidx = $j;
                   11125:                                         }
                   11126:                                     }
                   11127:                                 }
                   11128:                             }
                   11129:                             if ($itemidx ne '') {
                   11130:                                 if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   11131:                                     if ($mapinner{$referrer{$i}}) {
                   11132:                                         $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   11133:                                         for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11134:                                             if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11135:                                                 unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11136:                                                     $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
1.1067    raeburn  11137:                                                     $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
1.1056    raeburn  11138:                                                     if (!-e $fullpath) {
                   11139:                                                         mkdir($fullpath,0755);
                   11140:                                                     }
                   11141:                                                 }
                   11142:                                             } else {
                   11143:                                                 last;
                   11144:                                             }
                   11145:                                         }
                   11146:                                     }
                   11147:                                 } elsif ($newdest{$referrer{$i}}) {
                   11148:                                     $fullpath = $newdest{$referrer{$i}};
                   11149:                                     for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11150:                                         if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   11151:                                             $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   11152:                                             last;
                   11153:                                         } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11154:                                             unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11155:                                                 $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
1.1067    raeburn  11156:                                                 $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
1.1056    raeburn  11157:                                                 if (!-e $fullpath) {
                   11158:                                                     mkdir($fullpath,0755);
                   11159:                                                 }
                   11160:                                             }
                   11161:                                         } else {
                   11162:                                             last;
                   11163:                                         }
                   11164:                                     }
                   11165:                                 }
                   11166:                                 if ($fullpath ne '') {
1.1067    raeburn  11167:                                     if (-e "$prefix$path") {
                   11168:                                         system("mv $prefix$path $fullpath/$title");
                   11169:                                     }
                   11170:                                     if (-e "$fullpath/$title") {
                   11171:                                         my $showpath;
                   11172:                                         if ($relpath ne '') {
                   11173:                                             $showpath = "$relpath/$title";
                   11174:                                         } else {
                   11175:                                             $showpath = "/$title";
                   11176:                                         } 
                   11177:                                         $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   11178:                                     } 
                   11179:                                     unless ($ishome) {
                   11180:                                         my $fetch = "$fullpath/$title";
                   11181:                                         $fetch =~ s/^\Q$prefix$dir\E//; 
                   11182:                                         $prompttofetch{$fetch} = 1;
                   11183:                                     }
1.1056    raeburn  11184:                                 }
1.1055    raeburn  11185:                             }
                   11186:                         }
1.1056    raeburn  11187:                     } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   11188:                         $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   11189:                                         $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  11190:                     }
                   11191:                 }
                   11192:             } else {
                   11193:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   11194:             }
                   11195:         }
                   11196:         if (keys(%todelete)) {
                   11197:             foreach my $key (keys(%todelete)) {
                   11198:                 unlink($key);
1.1066    raeburn  11199:             }
                   11200:         }
                   11201:         if (keys(%todeletedir)) {
                   11202:             foreach my $key (keys(%todeletedir)) {
                   11203:                 rmdir($key);
                   11204:             }
                   11205:         }
                   11206:         foreach my $dir (sort(keys(%is_dir))) {
                   11207:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   11208:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  11209:             }
                   11210:         }
1.1067    raeburn  11211:         if ($result ne '') {
                   11212:             $output .= '<ul>'."\n".
                   11213:                        $result."\n".
                   11214:                        '</ul>';
                   11215:         }
                   11216:         unless ($ishome) {
                   11217:             my $replicationfail;
                   11218:             foreach my $item (keys(%prompttofetch)) {
                   11219:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   11220:                 unless ($fetchresult eq 'ok') {
                   11221:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   11222:                 }
                   11223:             }
                   11224:             if ($replicationfail) {
                   11225:                 $output .= '<p class="LC_error">'.
                   11226:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   11227:                            $replicationfail.
                   11228:                            '</ul></p>';
                   11229:             }
                   11230:         }
1.1055    raeburn  11231:     } else {
                   11232:         $warning = &mt('No items found in archive.');
                   11233:     }
                   11234:     if ($error) {
                   11235:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11236:                    $error.'</p>'."\n";
                   11237:     }
                   11238:     if ($warning) {
                   11239:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11240:     }
                   11241:     return $output;
                   11242: }
                   11243: 
1.1066    raeburn  11244: sub cleanup_empty_dirs {
                   11245:     my ($path) = @_;
                   11246:     if (($path ne '') && (-d $path)) {
                   11247:         if (opendir(my $dirh,$path)) {
                   11248:             my @dircontents = grep(!/^\./,readdir($dirh));
                   11249:             my $numitems = 0;
                   11250:             foreach my $item (@dircontents) {
                   11251:                 if (-d "$path/$item") {
                   11252:                     &recurse_dirs("$path/$item");
                   11253:                     if (-e "$path/$item") {
                   11254:                         $numitems ++;
                   11255:                     }
                   11256:                 } else {
                   11257:                     $numitems ++;
                   11258:                 }
                   11259:             }
                   11260:             if ($numitems == 0) {
                   11261:                 rmdir($path);
                   11262:             }
                   11263:             closedir($dirh);
                   11264:         }
                   11265:     }
                   11266:     return;
                   11267: }
                   11268: 
1.41      ng       11269: =pod
1.45      matthew  11270: 
1.1068    raeburn  11271: =item &get_folder_hierarchy()
                   11272: 
                   11273: Provides hierarchy of names of folders/sub-folders containing the current
                   11274: item,
                   11275: 
                   11276: Inputs: 3
                   11277:      - $navmap - navmaps object
                   11278: 
                   11279:      - $map - url for map (either the trigger itself, or map containing
                   11280:                            the resource, which is the trigger).
                   11281: 
                   11282:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   11283: 
                   11284: Outputs: 1 @pathitems - array of folder/subfolder names.
                   11285: 
                   11286: =cut
                   11287: 
                   11288: sub get_folder_hierarchy {
                   11289:     my ($navmap,$map,$showitem) = @_;
                   11290:     my @pathitems;
                   11291:     if (ref($navmap)) {
                   11292:         my $mapres = $navmap->getResourceByUrl($map);
                   11293:         if (ref($mapres)) {
                   11294:             my $pcslist = $mapres->map_hierarchy();
                   11295:             if ($pcslist ne '') {
                   11296:                 my @pcs = split(/,/,$pcslist);
                   11297:                 foreach my $pc (@pcs) {
                   11298:                     if ($pc == 1) {
                   11299:                         push(@pathitems,&mt('Main Course Documents'));
                   11300:                     } else {
                   11301:                         my $res = $navmap->getByMapPc($pc);
                   11302:                         if (ref($res)) {
                   11303:                             my $title = $res->compTitle();
                   11304:                             $title =~ s/\W+/_/g;
                   11305:                             if ($title ne '') {
                   11306:                                 push(@pathitems,$title);
                   11307:                             }
                   11308:                         }
                   11309:                     }
                   11310:                 }
                   11311:             }
1.1071    raeburn  11312:             if ($showitem) {
                   11313:                 if ($mapres->{ID} eq '0.0') {
                   11314:                     push(@pathitems,&mt('Main Course Documents'));
                   11315:                 } else {
                   11316:                     my $maptitle = $mapres->compTitle();
                   11317:                     $maptitle =~ s/\W+/_/g;
                   11318:                     if ($maptitle ne '') {
                   11319:                         push(@pathitems,$maptitle);
                   11320:                     }
1.1068    raeburn  11321:                 }
                   11322:             }
                   11323:         }
                   11324:     }
                   11325:     return @pathitems;
                   11326: }
                   11327: 
                   11328: =pod
                   11329: 
1.1015    raeburn  11330: =item * &get_turnedin_filepath()
                   11331: 
                   11332: Determines path in a user's portfolio file for storage of files uploaded
                   11333: to a specific essayresponse or dropbox item.
                   11334: 
                   11335: Inputs: 3 required + 1 optional.
                   11336: $symb is symb for resource, $uname and $udom are for current user (required).
                   11337: $caller is optional (can be "submission", if routine is called when storing
                   11338: an upoaded file when "Submit Answer" button was pressed).
                   11339: 
                   11340: Returns array containing $path and $multiresp. 
                   11341: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   11342: than one file upload item.  Callers of routine should append partid as a 
                   11343: subdirectory to $path in cases where $multiresp is 1.
                   11344: 
                   11345: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   11346: 
                   11347: =cut
                   11348: 
                   11349: sub get_turnedin_filepath {
                   11350:     my ($symb,$uname,$udom,$caller) = @_;
                   11351:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   11352:     my $turnindir;
                   11353:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   11354:     $turnindir = $userhash{'turnindir'};
                   11355:     my ($path,$multiresp);
                   11356:     if ($turnindir eq '') {
                   11357:         if ($caller eq 'submission') {
                   11358:             $turnindir = &mt('turned in');
                   11359:             $turnindir =~ s/\W+/_/g;
                   11360:             my %newhash = (
                   11361:                             'turnindir' => $turnindir,
                   11362:                           );
                   11363:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   11364:         }
                   11365:     }
                   11366:     if ($turnindir ne '') {
                   11367:         $path = '/'.$turnindir.'/';
                   11368:         my ($multipart,$turnin,@pathitems);
                   11369:         my $navmap = Apache::lonnavmaps::navmap->new();
                   11370:         if (defined($navmap)) {
                   11371:             my $mapres = $navmap->getResourceByUrl($map);
                   11372:             if (ref($mapres)) {
                   11373:                 my $pcslist = $mapres->map_hierarchy();
                   11374:                 if ($pcslist ne '') {
                   11375:                     foreach my $pc (split(/,/,$pcslist)) {
                   11376:                         my $res = $navmap->getByMapPc($pc);
                   11377:                         if (ref($res)) {
                   11378:                             my $title = $res->compTitle();
                   11379:                             $title =~ s/\W+/_/g;
                   11380:                             if ($title ne '') {
                   11381:                                 push(@pathitems,$title);
                   11382:                             }
                   11383:                         }
                   11384:                     }
                   11385:                 }
                   11386:                 my $maptitle = $mapres->compTitle();
                   11387:                 $maptitle =~ s/\W+/_/g;
                   11388:                 if ($maptitle ne '') {
                   11389:                     push(@pathitems,$maptitle);
                   11390:                 }
                   11391:                 unless ($env{'request.state'} eq 'construct') {
                   11392:                     my $res = $navmap->getBySymb($symb);
                   11393:                     if (ref($res)) {
                   11394:                         my $partlist = $res->parts();
                   11395:                         my $totaluploads = 0;
                   11396:                         if (ref($partlist) eq 'ARRAY') {
                   11397:                             foreach my $part (@{$partlist}) {
                   11398:                                 my @types = $res->responseType($part);
                   11399:                                 my @ids = $res->responseIds($part);
                   11400:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   11401:                                     if ($types[$i] eq 'essay') {
                   11402:                                         my $partid = $part.'_'.$ids[$i];
                   11403:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   11404:                                             $totaluploads ++;
                   11405:                                         }
                   11406:                                     }
                   11407:                                 }
                   11408:                             }
                   11409:                             if ($totaluploads > 1) {
                   11410:                                 $multiresp = 1;
                   11411:                             }
                   11412:                         }
                   11413:                     }
                   11414:                 }
                   11415:             } else {
                   11416:                 return;
                   11417:             }
                   11418:         } else {
                   11419:             return;
                   11420:         }
                   11421:         my $restitle=&Apache::lonnet::gettitle($symb);
                   11422:         $restitle =~ s/\W+/_/g;
                   11423:         if ($restitle eq '') {
                   11424:             $restitle = ($resurl =~ m{/[^/]+$});
                   11425:             if ($restitle eq '') {
                   11426:                 $restitle = time;
                   11427:             }
                   11428:         }
                   11429:         push(@pathitems,$restitle);
                   11430:         $path .= join('/',@pathitems);
                   11431:     }
                   11432:     return ($path,$multiresp);
                   11433: }
                   11434: 
                   11435: =pod
                   11436: 
1.464     albertel 11437: =back
1.41      ng       11438: 
1.112     bowersj2 11439: =head1 CSV Upload/Handling functions
1.38      albertel 11440: 
1.41      ng       11441: =over 4
                   11442: 
1.648     raeburn  11443: =item * &upfile_store($r)
1.41      ng       11444: 
                   11445: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 11446: needs $env{'form.upfile'}
1.41      ng       11447: returns $datatoken to be put into hidden field
                   11448: 
                   11449: =cut
1.31      albertel 11450: 
                   11451: sub upfile_store {
                   11452:     my $r=shift;
1.258     albertel 11453:     $env{'form.upfile'}=~s/\r/\n/gs;
                   11454:     $env{'form.upfile'}=~s/\f/\n/gs;
                   11455:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   11456:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 11457: 
1.258     albertel 11458:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   11459: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 11460:     {
1.158     raeburn  11461:         my $datafile = $r->dir_config('lonDaemons').
                   11462:                            '/tmp/'.$datatoken.'.tmp';
                   11463:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 11464:             print $fh $env{'form.upfile'};
1.158     raeburn  11465:             close($fh);
                   11466:         }
1.31      albertel 11467:     }
                   11468:     return $datatoken;
                   11469: }
                   11470: 
1.56      matthew  11471: =pod
                   11472: 
1.648     raeburn  11473: =item * &load_tmp_file($r)
1.41      ng       11474: 
                   11475: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 11476: needs $env{'form.datatoken'},
                   11477: sets $env{'form.upfile'} to the contents of the file
1.41      ng       11478: 
                   11479: =cut
1.31      albertel 11480: 
                   11481: sub load_tmp_file {
                   11482:     my $r=shift;
                   11483:     my @studentdata=();
                   11484:     {
1.158     raeburn  11485:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 11486:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  11487:         if ( open(my $fh,"<$studentfile") ) {
                   11488:             @studentdata=<$fh>;
                   11489:             close($fh);
                   11490:         }
1.31      albertel 11491:     }
1.258     albertel 11492:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 11493: }
                   11494: 
1.56      matthew  11495: =pod
                   11496: 
1.648     raeburn  11497: =item * &upfile_record_sep()
1.41      ng       11498: 
                   11499: Separate uploaded file into records
                   11500: returns array of records,
1.258     albertel 11501: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       11502: 
                   11503: =cut
1.31      albertel 11504: 
                   11505: sub upfile_record_sep {
1.258     albertel 11506:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 11507:     } else {
1.248     albertel 11508: 	my @records;
1.258     albertel 11509: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 11510: 	    if ($line=~/^\s*$/) { next; }
                   11511: 	    push(@records,$line);
                   11512: 	}
                   11513: 	return @records;
1.31      albertel 11514:     }
                   11515: }
                   11516: 
1.56      matthew  11517: =pod
                   11518: 
1.648     raeburn  11519: =item * &record_sep($record)
1.41      ng       11520: 
1.258     albertel 11521: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       11522: 
                   11523: =cut
                   11524: 
1.263     www      11525: sub takeleft {
                   11526:     my $index=shift;
                   11527:     return substr('0000'.$index,-4,4);
                   11528: }
                   11529: 
1.31      albertel 11530: sub record_sep {
                   11531:     my $record=shift;
                   11532:     my %components=();
1.258     albertel 11533:     if ($env{'form.upfiletype'} eq 'xml') {
                   11534:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 11535:         my $i=0;
1.356     albertel 11536:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 11537:             $field=~s/^(\"|\')//;
                   11538:             $field=~s/(\"|\')$//;
1.263     www      11539:             $components{&takeleft($i)}=$field;
1.31      albertel 11540:             $i++;
                   11541:         }
1.258     albertel 11542:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 11543:         my $i=0;
1.356     albertel 11544:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 11545:             $field=~s/^(\"|\')//;
                   11546:             $field=~s/(\"|\')$//;
1.263     www      11547:             $components{&takeleft($i)}=$field;
1.31      albertel 11548:             $i++;
                   11549:         }
                   11550:     } else {
1.561     www      11551:         my $separator=',';
1.480     banghart 11552:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      11553:             $separator=';';
1.480     banghart 11554:         }
1.31      albertel 11555:         my $i=0;
1.561     www      11556: # the character we are looking for to indicate the end of a quote or a record 
                   11557:         my $looking_for=$separator;
                   11558: # do not add the characters to the fields
                   11559:         my $ignore=0;
                   11560: # we just encountered a separator (or the beginning of the record)
                   11561:         my $just_found_separator=1;
                   11562: # store the field we are working on here
                   11563:         my $field='';
                   11564: # work our way through all characters in record
                   11565:         foreach my $character ($record=~/(.)/g) {
                   11566:             if ($character eq $looking_for) {
                   11567:                if ($character ne $separator) {
                   11568: # Found the end of a quote, again looking for separator
                   11569:                   $looking_for=$separator;
                   11570:                   $ignore=1;
                   11571:                } else {
                   11572: # Found a separator, store away what we got
                   11573:                   $components{&takeleft($i)}=$field;
                   11574: 	          $i++;
                   11575:                   $just_found_separator=1;
                   11576:                   $ignore=0;
                   11577:                   $field='';
                   11578:                }
                   11579:                next;
                   11580:             }
                   11581: # single or double quotation marks after a separator indicate beginning of a quote
                   11582: # we are now looking for the end of the quote and need to ignore separators
                   11583:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   11584:                $looking_for=$character;
                   11585:                next;
                   11586:             }
                   11587: # ignore would be true after we reached the end of a quote
                   11588:             if ($ignore) { next; }
                   11589:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   11590:             $field.=$character;
                   11591:             $just_found_separator=0; 
1.31      albertel 11592:         }
1.561     www      11593: # catch the very last entry, since we never encountered the separator
                   11594:         $components{&takeleft($i)}=$field;
1.31      albertel 11595:     }
                   11596:     return %components;
                   11597: }
                   11598: 
1.144     matthew  11599: ######################################################
                   11600: ######################################################
                   11601: 
1.56      matthew  11602: =pod
                   11603: 
1.648     raeburn  11604: =item * &upfile_select_html()
1.41      ng       11605: 
1.144     matthew  11606: Return HTML code to select a file from the users machine and specify 
                   11607: the file type.
1.41      ng       11608: 
                   11609: =cut
                   11610: 
1.144     matthew  11611: ######################################################
                   11612: ######################################################
1.31      albertel 11613: sub upfile_select_html {
1.144     matthew  11614:     my %Types = (
                   11615:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 11616:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  11617:                  space => &mt('Space separated'),
                   11618:                  tab   => &mt('Tabulator separated'),
                   11619: #                 xml   => &mt('HTML/XML'),
                   11620:                  );
                   11621:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  11622:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  11623:     foreach my $type (sort(keys(%Types))) {
                   11624:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   11625:     }
                   11626:     $Str .= "</select>\n";
                   11627:     return $Str;
1.31      albertel 11628: }
                   11629: 
1.301     albertel 11630: sub get_samples {
                   11631:     my ($records,$toget) = @_;
                   11632:     my @samples=({});
                   11633:     my $got=0;
                   11634:     foreach my $rec (@$records) {
                   11635: 	my %temp = &record_sep($rec);
                   11636: 	if (! grep(/\S/, values(%temp))) { next; }
                   11637: 	if (%temp) {
                   11638: 	    $samples[$got]=\%temp;
                   11639: 	    $got++;
                   11640: 	    if ($got == $toget) { last; }
                   11641: 	}
                   11642:     }
                   11643:     return \@samples;
                   11644: }
                   11645: 
1.144     matthew  11646: ######################################################
                   11647: ######################################################
                   11648: 
1.56      matthew  11649: =pod
                   11650: 
1.648     raeburn  11651: =item * &csv_print_samples($r,$records)
1.41      ng       11652: 
                   11653: Prints a table of sample values from each column uploaded $r is an
                   11654: Apache Request ref, $records is an arrayref from
                   11655: &Apache::loncommon::upfile_record_sep
                   11656: 
                   11657: =cut
                   11658: 
1.144     matthew  11659: ######################################################
                   11660: ######################################################
1.31      albertel 11661: sub csv_print_samples {
                   11662:     my ($r,$records) = @_;
1.662     bisitz   11663:     my $samples = &get_samples($records,5);
1.301     albertel 11664: 
1.594     raeburn  11665:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   11666:               &start_data_table_header_row());
1.356     albertel 11667:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   11668:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  11669:     $r->print(&end_data_table_header_row());
1.301     albertel 11670:     foreach my $hash (@$samples) {
1.594     raeburn  11671: 	$r->print(&start_data_table_row());
1.356     albertel 11672: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 11673: 	    $r->print('<td>');
1.356     albertel 11674: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 11675: 	    $r->print('</td>');
                   11676: 	}
1.594     raeburn  11677: 	$r->print(&end_data_table_row());
1.31      albertel 11678:     }
1.594     raeburn  11679:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 11680: }
                   11681: 
1.144     matthew  11682: ######################################################
                   11683: ######################################################
                   11684: 
1.56      matthew  11685: =pod
                   11686: 
1.648     raeburn  11687: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       11688: 
                   11689: Prints a table to create associations between values and table columns.
1.144     matthew  11690: 
1.41      ng       11691: $r is an Apache Request ref,
                   11692: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  11693: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       11694: 
                   11695: =cut
                   11696: 
1.144     matthew  11697: ######################################################
                   11698: ######################################################
1.31      albertel 11699: sub csv_print_select_table {
                   11700:     my ($r,$records,$d) = @_;
1.301     albertel 11701:     my $i=0;
                   11702:     my $samples = &get_samples($records,1);
1.144     matthew  11703:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  11704: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  11705:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  11706:               '<th>'.&mt('Column').'</th>'.
                   11707:               &end_data_table_header_row()."\n");
1.356     albertel 11708:     foreach my $array_ref (@$d) {
                   11709: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  11710: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 11711: 
1.875     bisitz   11712: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  11713: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 11714: 	$r->print('<option value="none"></option>');
1.356     albertel 11715: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   11716: 	    $r->print('<option value="'.$sample.'"'.
                   11717:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   11718:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 11719: 	}
1.594     raeburn  11720: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 11721: 	$i++;
                   11722:     }
1.594     raeburn  11723:     $r->print(&end_data_table());
1.31      albertel 11724:     $i--;
                   11725:     return $i;
                   11726: }
1.56      matthew  11727: 
1.144     matthew  11728: ######################################################
                   11729: ######################################################
                   11730: 
1.56      matthew  11731: =pod
1.31      albertel 11732: 
1.648     raeburn  11733: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       11734: 
                   11735: Prints a table of sample values from the upload and can make associate samples to internal names.
                   11736: 
                   11737: $r is an Apache Request ref,
                   11738: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   11739: $d is an array of 2 element arrays (internal name, displayed name)
                   11740: 
                   11741: =cut
                   11742: 
1.144     matthew  11743: ######################################################
                   11744: ######################################################
1.31      albertel 11745: sub csv_samples_select_table {
                   11746:     my ($r,$records,$d) = @_;
                   11747:     my $i=0;
1.144     matthew  11748:     #
1.662     bisitz   11749:     my $max_samples = 5;
                   11750:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  11751:     $r->print(&start_data_table().
                   11752:               &start_data_table_header_row().'<th>'.
                   11753:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   11754:               &end_data_table_header_row());
1.301     albertel 11755: 
                   11756:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  11757: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  11758: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 11759: 	foreach my $option (@$d) {
                   11760: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  11761: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 11762:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  11763:                       $display.'</option>');
1.31      albertel 11764: 	}
                   11765: 	$r->print('</select></td><td>');
1.662     bisitz   11766: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 11767: 	    if (defined($samples->[$line]{$key})) { 
                   11768: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   11769: 	    }
                   11770: 	}
1.594     raeburn  11771: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 11772: 	$i++;
                   11773:     }
1.594     raeburn  11774:     $r->print(&end_data_table());
1.31      albertel 11775:     $i--;
                   11776:     return($i);
1.115     matthew  11777: }
                   11778: 
1.144     matthew  11779: ######################################################
                   11780: ######################################################
                   11781: 
1.115     matthew  11782: =pod
                   11783: 
1.648     raeburn  11784: =item * &clean_excel_name($name)
1.115     matthew  11785: 
                   11786: Returns a replacement for $name which does not contain any illegal characters.
                   11787: 
                   11788: =cut
                   11789: 
1.144     matthew  11790: ######################################################
                   11791: ######################################################
1.115     matthew  11792: sub clean_excel_name {
                   11793:     my ($name) = @_;
                   11794:     $name =~ s/[:\*\?\/\\]//g;
                   11795:     if (length($name) > 31) {
                   11796:         $name = substr($name,0,31);
                   11797:     }
                   11798:     return $name;
1.25      albertel 11799: }
1.84      albertel 11800: 
1.85      albertel 11801: =pod
                   11802: 
1.648     raeburn  11803: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 11804: 
                   11805: Returns either 1 or undef
                   11806: 
                   11807: 1 if the part is to be hidden, undef if it is to be shown
                   11808: 
                   11809: Arguments are:
                   11810: 
                   11811: $id the id of the part to be checked
                   11812: $symb, optional the symb of the resource to check
                   11813: $udom, optional the domain of the user to check for
                   11814: $uname, optional the username of the user to check for
                   11815: 
                   11816: =cut
1.84      albertel 11817: 
                   11818: sub check_if_partid_hidden {
                   11819:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 11820:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 11821: 					 $symb,$udom,$uname);
1.141     albertel 11822:     my $truth=1;
                   11823:     #if the string starts with !, then the list is the list to show not hide
                   11824:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 11825:     my @hiddenlist=split(/,/,$hiddenparts);
                   11826:     foreach my $checkid (@hiddenlist) {
1.141     albertel 11827: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 11828:     }
1.141     albertel 11829:     return !$truth;
1.84      albertel 11830: }
1.127     matthew  11831: 
1.138     matthew  11832: 
                   11833: ############################################################
                   11834: ############################################################
                   11835: 
                   11836: =pod
                   11837: 
1.157     matthew  11838: =back 
                   11839: 
1.138     matthew  11840: =head1 cgi-bin script and graphing routines
                   11841: 
1.157     matthew  11842: =over 4
                   11843: 
1.648     raeburn  11844: =item * &get_cgi_id()
1.138     matthew  11845: 
                   11846: Inputs: none
                   11847: 
                   11848: Returns an id which can be used to pass environment variables
                   11849: to various cgi-bin scripts.  These environment variables will
                   11850: be removed from the users environment after a given time by
                   11851: the routine &Apache::lonnet::transfer_profile_to_env.
                   11852: 
                   11853: =cut
                   11854: 
                   11855: ############################################################
                   11856: ############################################################
1.152     albertel 11857: my $uniq=0;
1.136     matthew  11858: sub get_cgi_id {
1.154     albertel 11859:     $uniq=($uniq+1)%100000;
1.280     albertel 11860:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  11861: }
                   11862: 
1.127     matthew  11863: ############################################################
                   11864: ############################################################
                   11865: 
                   11866: =pod
                   11867: 
1.648     raeburn  11868: =item * &DrawBarGraph()
1.127     matthew  11869: 
1.138     matthew  11870: Facilitates the plotting of data in a (stacked) bar graph.
                   11871: Puts plot definition data into the users environment in order for 
                   11872: graph.png to plot it.  Returns an <img> tag for the plot.
                   11873: The bars on the plot are labeled '1','2',...,'n'.
                   11874: 
                   11875: Inputs:
                   11876: 
                   11877: =over 4
                   11878: 
                   11879: =item $Title: string, the title of the plot
                   11880: 
                   11881: =item $xlabel: string, text describing the X-axis of the plot
                   11882: 
                   11883: =item $ylabel: string, text describing the Y-axis of the plot
                   11884: 
                   11885: =item $Max: scalar, the maximum Y value to use in the plot
                   11886: If $Max is < any data point, the graph will not be rendered.
                   11887: 
1.140     matthew  11888: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  11889: they are plotted.  If undefined, default values will be used.
                   11890: 
1.178     matthew  11891: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   11892: 
1.138     matthew  11893: =item @Values: An array of array references.  Each array reference holds data
                   11894: to be plotted in a stacked bar chart.
                   11895: 
1.239     matthew  11896: =item If the final element of @Values is a hash reference the key/value
                   11897: pairs will be added to the graph definition.
                   11898: 
1.138     matthew  11899: =back
                   11900: 
                   11901: Returns:
                   11902: 
                   11903: An <img> tag which references graph.png and the appropriate identifying
                   11904: information for the plot.
                   11905: 
1.127     matthew  11906: =cut
                   11907: 
                   11908: ############################################################
                   11909: ############################################################
1.134     matthew  11910: sub DrawBarGraph {
1.178     matthew  11911:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  11912:     #
                   11913:     if (! defined($colors)) {
                   11914:         $colors = ['#33ff00', 
                   11915:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   11916:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   11917:                   ]; 
                   11918:     }
1.228     matthew  11919:     my $extra_settings = {};
                   11920:     if (ref($Values[-1]) eq 'HASH') {
                   11921:         $extra_settings = pop(@Values);
                   11922:     }
1.127     matthew  11923:     #
1.136     matthew  11924:     my $identifier = &get_cgi_id();
                   11925:     my $id = 'cgi.'.$identifier;        
1.129     matthew  11926:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  11927:         return '';
                   11928:     }
1.225     matthew  11929:     #
                   11930:     my @Labels;
                   11931:     if (defined($labels)) {
                   11932:         @Labels = @$labels;
                   11933:     } else {
                   11934:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   11935:             push (@Labels,$i+1);
                   11936:         }
                   11937:     }
                   11938:     #
1.129     matthew  11939:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  11940:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  11941:     my %ValuesHash;
                   11942:     my $NumSets=1;
                   11943:     foreach my $array (@Values) {
                   11944:         next if (! ref($array));
1.136     matthew  11945:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  11946:             join(',',@$array);
1.129     matthew  11947:     }
1.127     matthew  11948:     #
1.136     matthew  11949:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  11950:     if ($NumBars < 3) {
                   11951:         $width = 120+$NumBars*32;
1.220     matthew  11952:         $xskip = 1;
1.225     matthew  11953:         $bar_width = 30;
                   11954:     } elsif ($NumBars < 5) {
                   11955:         $width = 120+$NumBars*20;
                   11956:         $xskip = 1;
                   11957:         $bar_width = 20;
1.220     matthew  11958:     } elsif ($NumBars < 10) {
1.136     matthew  11959:         $width = 120+$NumBars*15;
                   11960:         $xskip = 1;
                   11961:         $bar_width = 15;
                   11962:     } elsif ($NumBars <= 25) {
                   11963:         $width = 120+$NumBars*11;
                   11964:         $xskip = 5;
                   11965:         $bar_width = 8;
                   11966:     } elsif ($NumBars <= 50) {
                   11967:         $width = 120+$NumBars*8;
                   11968:         $xskip = 5;
                   11969:         $bar_width = 4;
                   11970:     } else {
                   11971:         $width = 120+$NumBars*8;
                   11972:         $xskip = 5;
                   11973:         $bar_width = 4;
                   11974:     }
                   11975:     #
1.137     matthew  11976:     $Max = 1 if ($Max < 1);
                   11977:     if ( int($Max) < $Max ) {
                   11978:         $Max++;
                   11979:         $Max = int($Max);
                   11980:     }
1.127     matthew  11981:     $Title  = '' if (! defined($Title));
                   11982:     $xlabel = '' if (! defined($xlabel));
                   11983:     $ylabel = '' if (! defined($ylabel));
1.369     www      11984:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   11985:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   11986:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  11987:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  11988:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   11989:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   11990:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   11991:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   11992:     $ValuesHash{$id.'.height'}   = $height;
                   11993:     $ValuesHash{$id.'.width'}    = $width;
                   11994:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   11995:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   11996:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  11997:     #
1.228     matthew  11998:     # Deal with other parameters
                   11999:     while (my ($key,$value) = each(%$extra_settings)) {
                   12000:         $ValuesHash{$id.'.'.$key} = $value;
                   12001:     }
                   12002:     #
1.646     raeburn  12003:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12004:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12005: }
                   12006: 
                   12007: ############################################################
                   12008: ############################################################
                   12009: 
                   12010: =pod
                   12011: 
1.648     raeburn  12012: =item * &DrawXYGraph()
1.137     matthew  12013: 
1.138     matthew  12014: Facilitates the plotting of data in an XY graph.
                   12015: Puts plot definition data into the users environment in order for 
                   12016: graph.png to plot it.  Returns an <img> tag for the plot.
                   12017: 
                   12018: Inputs:
                   12019: 
                   12020: =over 4
                   12021: 
                   12022: =item $Title: string, the title of the plot
                   12023: 
                   12024: =item $xlabel: string, text describing the X-axis of the plot
                   12025: 
                   12026: =item $ylabel: string, text describing the Y-axis of the plot
                   12027: 
                   12028: =item $Max: scalar, the maximum Y value to use in the plot
                   12029: If $Max is < any data point, the graph will not be rendered.
                   12030: 
                   12031: =item $colors: Array ref containing the hex color codes for the data to be 
                   12032: plotted in.  If undefined, default values will be used.
                   12033: 
                   12034: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12035: 
                   12036: =item $Ydata: Array ref containing Array refs.  
1.185     www      12037: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12038: 
                   12039: =item %Values: hash indicating or overriding any default values which are 
                   12040: passed to graph.png.  
                   12041: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12042: 
                   12043: =back
                   12044: 
                   12045: Returns:
                   12046: 
                   12047: An <img> tag which references graph.png and the appropriate identifying
                   12048: information for the plot.
                   12049: 
1.137     matthew  12050: =cut
                   12051: 
                   12052: ############################################################
                   12053: ############################################################
                   12054: sub DrawXYGraph {
                   12055:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12056:     #
                   12057:     # Create the identifier for the graph
                   12058:     my $identifier = &get_cgi_id();
                   12059:     my $id = 'cgi.'.$identifier;
                   12060:     #
                   12061:     $Title  = '' if (! defined($Title));
                   12062:     $xlabel = '' if (! defined($xlabel));
                   12063:     $ylabel = '' if (! defined($ylabel));
                   12064:     my %ValuesHash = 
                   12065:         (
1.369     www      12066:          $id.'.title'  => &escape($Title),
                   12067:          $id.'.xlabel' => &escape($xlabel),
                   12068:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12069:          $id.'.y_max_value'=> $Max,
                   12070:          $id.'.labels'     => join(',',@$Xlabels),
                   12071:          $id.'.PlotType'   => 'XY',
                   12072:          );
                   12073:     #
                   12074:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12075:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12076:     }
                   12077:     #
                   12078:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12079:         return '';
                   12080:     }
                   12081:     my $NumSets=1;
1.138     matthew  12082:     foreach my $array (@{$Ydata}){
1.137     matthew  12083:         next if (! ref($array));
                   12084:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12085:     }
1.138     matthew  12086:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12087:     #
                   12088:     # Deal with other parameters
                   12089:     while (my ($key,$value) = each(%Values)) {
                   12090:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12091:     }
                   12092:     #
1.646     raeburn  12093:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12094:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12095: }
                   12096: 
                   12097: ############################################################
                   12098: ############################################################
                   12099: 
                   12100: =pod
                   12101: 
1.648     raeburn  12102: =item * &DrawXYYGraph()
1.138     matthew  12103: 
                   12104: Facilitates the plotting of data in an XY graph with two Y axes.
                   12105: Puts plot definition data into the users environment in order for 
                   12106: graph.png to plot it.  Returns an <img> tag for the plot.
                   12107: 
                   12108: Inputs:
                   12109: 
                   12110: =over 4
                   12111: 
                   12112: =item $Title: string, the title of the plot
                   12113: 
                   12114: =item $xlabel: string, text describing the X-axis of the plot
                   12115: 
                   12116: =item $ylabel: string, text describing the Y-axis of the plot
                   12117: 
                   12118: =item $colors: Array ref containing the hex color codes for the data to be 
                   12119: plotted in.  If undefined, default values will be used.
                   12120: 
                   12121: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12122: 
                   12123: =item $Ydata1: The first data set
                   12124: 
                   12125: =item $Min1: The minimum value of the left Y-axis
                   12126: 
                   12127: =item $Max1: The maximum value of the left Y-axis
                   12128: 
                   12129: =item $Ydata2: The second data set
                   12130: 
                   12131: =item $Min2: The minimum value of the right Y-axis
                   12132: 
                   12133: =item $Max2: The maximum value of the left Y-axis
                   12134: 
                   12135: =item %Values: hash indicating or overriding any default values which are 
                   12136: passed to graph.png.  
                   12137: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12138: 
                   12139: =back
                   12140: 
                   12141: Returns:
                   12142: 
                   12143: An <img> tag which references graph.png and the appropriate identifying
                   12144: information for the plot.
1.136     matthew  12145: 
                   12146: =cut
                   12147: 
                   12148: ############################################################
                   12149: ############################################################
1.137     matthew  12150: sub DrawXYYGraph {
                   12151:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   12152:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  12153:     #
                   12154:     # Create the identifier for the graph
                   12155:     my $identifier = &get_cgi_id();
                   12156:     my $id = 'cgi.'.$identifier;
                   12157:     #
                   12158:     $Title  = '' if (! defined($Title));
                   12159:     $xlabel = '' if (! defined($xlabel));
                   12160:     $ylabel = '' if (! defined($ylabel));
                   12161:     my %ValuesHash = 
                   12162:         (
1.369     www      12163:          $id.'.title'  => &escape($Title),
                   12164:          $id.'.xlabel' => &escape($xlabel),
                   12165:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  12166:          $id.'.labels' => join(',',@$Xlabels),
                   12167:          $id.'.PlotType' => 'XY',
                   12168:          $id.'.NumSets' => 2,
1.137     matthew  12169:          $id.'.two_axes' => 1,
                   12170:          $id.'.y1_max_value' => $Max1,
                   12171:          $id.'.y1_min_value' => $Min1,
                   12172:          $id.'.y2_max_value' => $Max2,
                   12173:          $id.'.y2_min_value' => $Min2,
1.136     matthew  12174:          );
                   12175:     #
1.137     matthew  12176:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12177:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12178:     }
                   12179:     #
                   12180:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   12181:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  12182:         return '';
                   12183:     }
                   12184:     my $NumSets=1;
1.137     matthew  12185:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  12186:         next if (! ref($array));
                   12187:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  12188:     }
                   12189:     #
                   12190:     # Deal with other parameters
                   12191:     while (my ($key,$value) = each(%Values)) {
                   12192:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  12193:     }
                   12194:     #
1.646     raeburn  12195:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 12196:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  12197: }
                   12198: 
                   12199: ############################################################
                   12200: ############################################################
                   12201: 
                   12202: =pod
                   12203: 
1.157     matthew  12204: =back 
                   12205: 
1.139     matthew  12206: =head1 Statistics helper routines?  
                   12207: 
                   12208: Bad place for them but what the hell.
                   12209: 
1.157     matthew  12210: =over 4
                   12211: 
1.648     raeburn  12212: =item * &chartlink()
1.139     matthew  12213: 
                   12214: Returns a link to the chart for a specific student.  
                   12215: 
                   12216: Inputs:
                   12217: 
                   12218: =over 4
                   12219: 
                   12220: =item $linktext: The text of the link
                   12221: 
                   12222: =item $sname: The students username
                   12223: 
                   12224: =item $sdomain: The students domain
                   12225: 
                   12226: =back
                   12227: 
1.157     matthew  12228: =back
                   12229: 
1.139     matthew  12230: =cut
                   12231: 
                   12232: ############################################################
                   12233: ############################################################
                   12234: sub chartlink {
                   12235:     my ($linktext, $sname, $sdomain) = @_;
                   12236:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      12237:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 12238:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  12239:        '">'.$linktext.'</a>';
1.153     matthew  12240: }
                   12241: 
                   12242: #######################################################
                   12243: #######################################################
                   12244: 
                   12245: =pod
                   12246: 
                   12247: =head1 Course Environment Routines
1.157     matthew  12248: 
                   12249: =over 4
1.153     matthew  12250: 
1.648     raeburn  12251: =item * &restore_course_settings()
1.153     matthew  12252: 
1.648     raeburn  12253: =item * &store_course_settings()
1.153     matthew  12254: 
                   12255: Restores/Store indicated form parameters from the course environment.
                   12256: Will not overwrite existing values of the form parameters.
                   12257: 
                   12258: Inputs: 
                   12259: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   12260: 
                   12261: a hash ref describing the data to be stored.  For example:
                   12262:    
                   12263: %Save_Parameters = ('Status' => 'scalar',
                   12264:     'chartoutputmode' => 'scalar',
                   12265:     'chartoutputdata' => 'scalar',
                   12266:     'Section' => 'array',
1.373     raeburn  12267:     'Group' => 'array',
1.153     matthew  12268:     'StudentData' => 'array',
                   12269:     'Maps' => 'array');
                   12270: 
                   12271: Returns: both routines return nothing
                   12272: 
1.631     raeburn  12273: =back
                   12274: 
1.153     matthew  12275: =cut
                   12276: 
                   12277: #######################################################
                   12278: #######################################################
                   12279: sub store_course_settings {
1.496     albertel 12280:     return &store_settings($env{'request.course.id'},@_);
                   12281: }
                   12282: 
                   12283: sub store_settings {
1.153     matthew  12284:     # save to the environment
                   12285:     # appenv the same items, just to be safe
1.300     albertel 12286:     my $udom  = $env{'user.domain'};
                   12287:     my $uname = $env{'user.name'};
1.496     albertel 12288:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12289:     my %SaveHash;
                   12290:     my %AppHash;
                   12291:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 12292:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 12293:         my $envname = 'environment.'.$basename;
1.258     albertel 12294:         if (exists($env{'form.'.$setting})) {
1.153     matthew  12295:             # Save this value away
                   12296:             if ($type eq 'scalar' &&
1.258     albertel 12297:                 (! exists($env{$envname}) || 
                   12298:                  $env{$envname} ne $env{'form.'.$setting})) {
                   12299:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   12300:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  12301:             } elsif ($type eq 'array') {
                   12302:                 my $stored_form;
1.258     albertel 12303:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  12304:                     $stored_form = join(',',
                   12305:                                         map {
1.369     www      12306:                                             &escape($_);
1.258     albertel 12307:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  12308:                 } else {
                   12309:                     $stored_form = 
1.369     www      12310:                         &escape($env{'form.'.$setting});
1.153     matthew  12311:                 }
                   12312:                 # Determine if the array contents are the same.
1.258     albertel 12313:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  12314:                     $SaveHash{$basename} = $stored_form;
                   12315:                     $AppHash{$envname}   = $stored_form;
                   12316:                 }
                   12317:             }
                   12318:         }
                   12319:     }
                   12320:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 12321:                                           $udom,$uname);
1.153     matthew  12322:     if ($put_result !~ /^(ok|delayed)/) {
                   12323:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   12324:                                  'got error:'.$put_result);
                   12325:     }
                   12326:     # Make sure these settings stick around in this session, too
1.646     raeburn  12327:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  12328:     return;
                   12329: }
                   12330: 
                   12331: sub restore_course_settings {
1.499     albertel 12332:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 12333: }
                   12334: 
                   12335: sub restore_settings {
                   12336:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  12337:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 12338:         next if (exists($env{'form.'.$setting}));
1.496     albertel 12339:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  12340:             '.'.$setting;
1.258     albertel 12341:         if (exists($env{$envname})) {
1.153     matthew  12342:             if ($type eq 'scalar') {
1.258     albertel 12343:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  12344:             } elsif ($type eq 'array') {
1.258     albertel 12345:                 $env{'form.'.$setting} = [ 
1.153     matthew  12346:                                            map { 
1.369     www      12347:                                                &unescape($_); 
1.258     albertel 12348:                                            } split(',',$env{$envname})
1.153     matthew  12349:                                            ];
                   12350:             }
                   12351:         }
                   12352:     }
1.127     matthew  12353: }
                   12354: 
1.618     raeburn  12355: #######################################################
                   12356: #######################################################
                   12357: 
                   12358: =pod
                   12359: 
                   12360: =head1 Domain E-mail Routines  
                   12361: 
                   12362: =over 4
                   12363: 
1.648     raeburn  12364: =item * &build_recipient_list()
1.618     raeburn  12365: 
1.884     raeburn  12366: Build recipient lists for five types of e-mail:
1.766     raeburn  12367: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  12368: (d) Help requests, (e) Course requests needing approval,  generated by
                   12369: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   12370: loncoursequeueadmin.pm respectively.
1.618     raeburn  12371: 
                   12372: Inputs:
1.619     raeburn  12373: defmail (scalar - email address of default recipient), 
1.618     raeburn  12374: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  12375: defdom (domain for which to retrieve configuration settings),
                   12376: origmail (scalar - email address of recipient from loncapa.conf, 
                   12377: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  12378: 
1.655     raeburn  12379: Returns: comma separated list of addresses to which to send e-mail.
                   12380: 
                   12381: =back
1.618     raeburn  12382: 
                   12383: =cut
                   12384: 
                   12385: ############################################################
                   12386: ############################################################
                   12387: sub build_recipient_list {
1.619     raeburn  12388:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  12389:     my @recipients;
                   12390:     my $otheremails;
                   12391:     my %domconfig =
                   12392:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   12393:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  12394:         if (exists($domconfig{'contacts'}{$mailing})) {
                   12395:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   12396:                 my @contacts = ('adminemail','supportemail');
                   12397:                 foreach my $item (@contacts) {
                   12398:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   12399:                         my $addr = $domconfig{'contacts'}{$item}; 
                   12400:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12401:                             push(@recipients,$addr);
                   12402:                         }
1.619     raeburn  12403:                     }
1.766     raeburn  12404:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  12405:                 }
                   12406:             }
1.766     raeburn  12407:         } elsif ($origmail ne '') {
                   12408:             push(@recipients,$origmail);
1.618     raeburn  12409:         }
1.619     raeburn  12410:     } elsif ($origmail ne '') {
                   12411:         push(@recipients,$origmail);
1.618     raeburn  12412:     }
1.688     raeburn  12413:     if (defined($defmail)) {
                   12414:         if ($defmail ne '') {
                   12415:             push(@recipients,$defmail);
                   12416:         }
1.618     raeburn  12417:     }
                   12418:     if ($otheremails) {
1.619     raeburn  12419:         my @others;
                   12420:         if ($otheremails =~ /,/) {
                   12421:             @others = split(/,/,$otheremails);
1.618     raeburn  12422:         } else {
1.619     raeburn  12423:             push(@others,$otheremails);
                   12424:         }
                   12425:         foreach my $addr (@others) {
                   12426:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   12427:                 push(@recipients,$addr);
                   12428:             }
1.618     raeburn  12429:         }
                   12430:     }
1.619     raeburn  12431:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  12432:     return $recipientlist;
                   12433: }
                   12434: 
1.127     matthew  12435: ############################################################
                   12436: ############################################################
1.154     albertel 12437: 
1.655     raeburn  12438: =pod
                   12439: 
                   12440: =head1 Course Catalog Routines
                   12441: 
                   12442: =over 4
                   12443: 
                   12444: =item * &gather_categories()
                   12445: 
                   12446: Converts category definitions - keys of categories hash stored in  
                   12447: coursecategories in configuration.db on the primary library server in a 
                   12448: domain - to an array.  Also generates javascript and idx hash used to 
                   12449: generate Domain Coordinator interface for editing Course Categories.
                   12450: 
                   12451: Inputs:
1.663     raeburn  12452: 
1.655     raeburn  12453: categories (reference to hash of category definitions).
1.663     raeburn  12454: 
1.655     raeburn  12455: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12456:       categories and subcategories).
1.663     raeburn  12457: 
1.655     raeburn  12458: idx (reference to hash of counters used in Domain Coordinator interface for 
                   12459:       editing Course Categories).
1.663     raeburn  12460: 
1.655     raeburn  12461: jsarray (reference to array of categories used to create Javascript arrays for
                   12462:          Domain Coordinator interface for editing Course Categories).
                   12463: 
                   12464: Returns: nothing
                   12465: 
                   12466: Side effects: populates cats, idx and jsarray. 
                   12467: 
                   12468: =cut
                   12469: 
                   12470: sub gather_categories {
                   12471:     my ($categories,$cats,$idx,$jsarray) = @_;
                   12472:     my %counters;
                   12473:     my $num = 0;
                   12474:     foreach my $item (keys(%{$categories})) {
                   12475:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   12476:         if ($container eq '' && $depth == 0) {
                   12477:             $cats->[$depth][$categories->{$item}] = $cat;
                   12478:         } else {
                   12479:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   12480:         }
                   12481:         my ($escitem,$tail) = split(/:/,$item,2);
                   12482:         if ($counters{$tail} eq '') {
                   12483:             $counters{$tail} = $num;
                   12484:             $num ++;
                   12485:         }
                   12486:         if (ref($idx) eq 'HASH') {
                   12487:             $idx->{$item} = $counters{$tail};
                   12488:         }
                   12489:         if (ref($jsarray) eq 'ARRAY') {
                   12490:             push(@{$jsarray->[$counters{$tail}]},$item);
                   12491:         }
                   12492:     }
                   12493:     return;
                   12494: }
                   12495: 
                   12496: =pod
                   12497: 
                   12498: =item * &extract_categories()
                   12499: 
                   12500: Used to generate breadcrumb trails for course categories.
                   12501: 
                   12502: Inputs:
1.663     raeburn  12503: 
1.655     raeburn  12504: categories (reference to hash of category definitions).
1.663     raeburn  12505: 
1.655     raeburn  12506: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12507:       categories and subcategories).
1.663     raeburn  12508: 
1.655     raeburn  12509: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  12510: 
1.655     raeburn  12511: allitems (reference to hash - key is category key 
                   12512:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12513: 
1.655     raeburn  12514: idx (reference to hash of counters used in Domain Coordinator interface for
                   12515:       editing Course Categories).
1.663     raeburn  12516: 
1.655     raeburn  12517: jsarray (reference to array of categories used to create Javascript arrays for
                   12518:          Domain Coordinator interface for editing Course Categories).
                   12519: 
1.665     raeburn  12520: subcats (reference to hash of arrays containing all subcategories within each 
                   12521:          category, -recursive)
                   12522: 
1.655     raeburn  12523: Returns: nothing
                   12524: 
                   12525: Side effects: populates trails and allitems hash references.
                   12526: 
                   12527: =cut
                   12528: 
                   12529: sub extract_categories {
1.665     raeburn  12530:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  12531:     if (ref($categories) eq 'HASH') {
                   12532:         &gather_categories($categories,$cats,$idx,$jsarray);
                   12533:         if (ref($cats->[0]) eq 'ARRAY') {
                   12534:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   12535:                 my $name = $cats->[0][$i];
                   12536:                 my $item = &escape($name).'::0';
                   12537:                 my $trailstr;
                   12538:                 if ($name eq 'instcode') {
                   12539:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  12540:                 } elsif ($name eq 'communities') {
                   12541:                     $trailstr = &mt('Communities');
1.655     raeburn  12542:                 } else {
                   12543:                     $trailstr = $name;
                   12544:                 }
                   12545:                 if ($allitems->{$item} eq '') {
                   12546:                     push(@{$trails},$trailstr);
                   12547:                     $allitems->{$item} = scalar(@{$trails})-1;
                   12548:                 }
                   12549:                 my @parents = ($name);
                   12550:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   12551:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   12552:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  12553:                         if (ref($subcats) eq 'HASH') {
                   12554:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   12555:                         }
                   12556:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   12557:                     }
                   12558:                 } else {
                   12559:                     if (ref($subcats) eq 'HASH') {
                   12560:                         $subcats->{$item} = [];
1.655     raeburn  12561:                     }
                   12562:                 }
                   12563:             }
                   12564:         }
                   12565:     }
                   12566:     return;
                   12567: }
                   12568: 
                   12569: =pod
                   12570: 
                   12571: =item *&recurse_categories()
                   12572: 
                   12573: Recursively used to generate breadcrumb trails for course categories.
                   12574: 
                   12575: Inputs:
1.663     raeburn  12576: 
1.655     raeburn  12577: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   12578:       categories and subcategories).
1.663     raeburn  12579: 
1.655     raeburn  12580: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  12581: 
                   12582: category (current course category, for which breadcrumb trail is being generated).
                   12583: 
                   12584: trails (reference to array of breadcrumb trails for each category).
                   12585: 
1.655     raeburn  12586: allitems (reference to hash - key is category key
                   12587:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  12588: 
1.655     raeburn  12589: parents (array containing containers directories for current category, 
                   12590:          back to top level). 
                   12591: 
                   12592: Returns: nothing
                   12593: 
                   12594: Side effects: populates trails and allitems hash references
                   12595: 
                   12596: =cut
                   12597: 
                   12598: sub recurse_categories {
1.665     raeburn  12599:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  12600:     my $shallower = $depth - 1;
                   12601:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   12602:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   12603:             my $name = $cats->[$depth]{$category}[$k];
                   12604:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12605:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12606:             if ($allitems->{$item} eq '') {
                   12607:                 push(@{$trails},$trailstr);
                   12608:                 $allitems->{$item} = scalar(@{$trails})-1;
                   12609:             }
                   12610:             my $deeper = $depth+1;
                   12611:             push(@{$parents},$category);
1.665     raeburn  12612:             if (ref($subcats) eq 'HASH') {
                   12613:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   12614:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   12615:                     my $higher;
                   12616:                     if ($j > 0) {
                   12617:                         $higher = &escape($parents->[$j]).':'.
                   12618:                                   &escape($parents->[$j-1]).':'.$j;
                   12619:                     } else {
                   12620:                         $higher = &escape($parents->[$j]).'::'.$j;
                   12621:                     }
                   12622:                     push(@{$subcats->{$higher}},$subcat);
                   12623:                 }
                   12624:             }
                   12625:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   12626:                                 $subcats);
1.655     raeburn  12627:             pop(@{$parents});
                   12628:         }
                   12629:     } else {
                   12630:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   12631:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   12632:         if ($allitems->{$item} eq '') {
                   12633:             push(@{$trails},$trailstr);
                   12634:             $allitems->{$item} = scalar(@{$trails})-1;
                   12635:         }
                   12636:     }
                   12637:     return;
                   12638: }
                   12639: 
1.663     raeburn  12640: =pod
                   12641: 
                   12642: =item *&assign_categories_table()
                   12643: 
                   12644: Create a datatable for display of hierarchical categories in a domain,
                   12645: with checkboxes to allow a course to be categorized. 
                   12646: 
                   12647: Inputs:
                   12648: 
                   12649: cathash - reference to hash of categories defined for the domain (from
                   12650:           configuration.db)
                   12651: 
                   12652: currcat - scalar with an & separated list of categories assigned to a course. 
                   12653: 
1.919     raeburn  12654: type    - scalar contains course type (Course or Community).
                   12655: 
1.663     raeburn  12656: Returns: $output (markup to be displayed) 
                   12657: 
                   12658: =cut
                   12659: 
                   12660: sub assign_categories_table {
1.919     raeburn  12661:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  12662:     my $output;
                   12663:     if (ref($cathash) eq 'HASH') {
                   12664:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   12665:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   12666:         $maxdepth = scalar(@cats);
                   12667:         if (@cats > 0) {
                   12668:             my $itemcount = 0;
                   12669:             if (ref($cats[0]) eq 'ARRAY') {
                   12670:                 my @currcategories;
                   12671:                 if ($currcat ne '') {
                   12672:                     @currcategories = split('&',$currcat);
                   12673:                 }
1.919     raeburn  12674:                 my $table;
1.663     raeburn  12675:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   12676:                     my $parent = $cats[0][$i];
1.919     raeburn  12677:                     next if ($parent eq 'instcode');
                   12678:                     if ($type eq 'Community') {
                   12679:                         next unless ($parent eq 'communities');
                   12680:                     } else {
                   12681:                         next if ($parent eq 'communities');
                   12682:                     }
1.663     raeburn  12683:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   12684:                     my $item = &escape($parent).'::0';
                   12685:                     my $checked = '';
                   12686:                     if (@currcategories > 0) {
                   12687:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   12688:                             $checked = ' checked="checked"';
1.663     raeburn  12689:                         }
                   12690:                     }
1.919     raeburn  12691:                     my $parent_title = $parent;
                   12692:                     if ($parent eq 'communities') {
                   12693:                         $parent_title = &mt('Communities');
                   12694:                     }
                   12695:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   12696:                               '<input type="checkbox" name="usecategory" value="'.
                   12697:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   12698:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  12699:                     my $depth = 1;
                   12700:                     push(@path,$parent);
1.919     raeburn  12701:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  12702:                     pop(@path);
1.919     raeburn  12703:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  12704:                     $itemcount ++;
                   12705:                 }
1.919     raeburn  12706:                 if ($itemcount) {
                   12707:                     $output = &Apache::loncommon::start_data_table().
                   12708:                               $table.
                   12709:                               &Apache::loncommon::end_data_table();
                   12710:                 }
1.663     raeburn  12711:             }
                   12712:         }
                   12713:     }
                   12714:     return $output;
                   12715: }
                   12716: 
                   12717: =pod
                   12718: 
                   12719: =item *&assign_category_rows()
                   12720: 
                   12721: Create a datatable row for display of nested categories in a domain,
                   12722: with checkboxes to allow a course to be categorized,called recursively.
                   12723: 
                   12724: Inputs:
                   12725: 
                   12726: itemcount - track row number for alternating colors
                   12727: 
                   12728: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   12729:       categories and subcategories.
                   12730: 
                   12731: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   12732: 
                   12733: parent - parent of current category item
                   12734: 
                   12735: path - Array containing all categories back up through the hierarchy from the
                   12736:        current category to the top level.
                   12737: 
                   12738: currcategories - reference to array of current categories assigned to the course
                   12739: 
                   12740: Returns: $output (markup to be displayed).
                   12741: 
                   12742: =cut
                   12743: 
                   12744: sub assign_category_rows {
                   12745:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   12746:     my ($text,$name,$item,$chgstr);
                   12747:     if (ref($cats) eq 'ARRAY') {
                   12748:         my $maxdepth = scalar(@{$cats});
                   12749:         if (ref($cats->[$depth]) eq 'HASH') {
                   12750:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   12751:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   12752:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   12753:                 $text .= '<td><table class="LC_datatable">';
                   12754:                 for (my $j=0; $j<$numchildren; $j++) {
                   12755:                     $name = $cats->[$depth]{$parent}[$j];
                   12756:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   12757:                     my $deeper = $depth+1;
                   12758:                     my $checked = '';
                   12759:                     if (ref($currcategories) eq 'ARRAY') {
                   12760:                         if (@{$currcategories} > 0) {
                   12761:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   12762:                                 $checked = ' checked="checked"';
1.663     raeburn  12763:                             }
                   12764:                         }
                   12765:                     }
1.664     raeburn  12766:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   12767:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  12768:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   12769:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   12770:                              '</td><td>';
1.663     raeburn  12771:                     if (ref($path) eq 'ARRAY') {
                   12772:                         push(@{$path},$name);
                   12773:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   12774:                         pop(@{$path});
                   12775:                     }
                   12776:                     $text .= '</td></tr>';
                   12777:                 }
                   12778:                 $text .= '</table></td>';
                   12779:             }
                   12780:         }
                   12781:     }
                   12782:     return $text;
                   12783: }
                   12784: 
1.655     raeburn  12785: ############################################################
                   12786: ############################################################
                   12787: 
                   12788: 
1.443     albertel 12789: sub commit_customrole {
1.664     raeburn  12790:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  12791:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 12792:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   12793:                          ($end?', ending '.localtime($end):'').': <b>'.
                   12794:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  12795:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 12796:                  '</b><br />';
                   12797:     return $output;
                   12798: }
                   12799: 
                   12800: sub commit_standardrole {
1.541     raeburn  12801:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
                   12802:     my ($output,$logmsg,$linefeed);
                   12803:     if ($context eq 'auto') {
                   12804:         $linefeed = "\n";
                   12805:     } else {
                   12806:         $linefeed = "<br />\n";
                   12807:     }  
1.443     albertel 12808:     if ($three eq 'st') {
1.541     raeburn  12809:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
                   12810:                                          $one,$two,$sec,$context);
                   12811:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  12812:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   12813:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 12814:         } else {
1.541     raeburn  12815:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 12816:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  12817:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   12818:             if ($context eq 'auto') {
                   12819:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   12820:             } else {
                   12821:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   12822:                &mt('Add to classlist').': <b>ok</b>';
                   12823:             }
                   12824:             $output .= $linefeed;
1.443     albertel 12825:         }
                   12826:     } else {
                   12827:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   12828:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  12829:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  12830:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  12831:         if ($context eq 'auto') {
                   12832:             $output .= $result.$linefeed;
                   12833:         } else {
                   12834:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   12835:         }
1.443     albertel 12836:     }
                   12837:     return $output;
                   12838: }
                   12839: 
                   12840: sub commit_studentrole {
1.541     raeburn  12841:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context) = @_;
1.626     raeburn  12842:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  12843:     if ($context eq 'auto') {
                   12844:         $linefeed = "\n";
                   12845:     } else {
                   12846:         $linefeed = '<br />'."\n";
                   12847:     }
1.443     albertel 12848:     if (defined($one) && defined($two)) {
                   12849:         my $cid=$one.'_'.$two;
                   12850:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   12851:         my $secchange = 0;
                   12852:         my $expire_role_result;
                   12853:         my $modify_section_result;
1.628     raeburn  12854:         if ($oldsec ne '-1') { 
                   12855:             if ($oldsec ne $sec) {
1.443     albertel 12856:                 $secchange = 1;
1.628     raeburn  12857:                 my $now = time;
1.443     albertel 12858:                 my $uurl='/'.$cid;
                   12859:                 $uurl=~s/\_/\//g;
                   12860:                 if ($oldsec) {
                   12861:                     $uurl.='/'.$oldsec;
                   12862:                 }
1.626     raeburn  12863:                 $oldsecurl = $uurl;
1.628     raeburn  12864:                 $expire_role_result = 
1.652     raeburn  12865:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  12866:                 if ($env{'request.course.sec'} ne '') { 
                   12867:                     if ($expire_role_result eq 'refused') {
                   12868:                         my @roles = ('st');
                   12869:                         my @statuses = ('previous');
                   12870:                         my @roledoms = ($one);
                   12871:                         my $withsec = 1;
                   12872:                         my %roleshash = 
                   12873:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   12874:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   12875:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   12876:                             my ($oldstart,$oldend) = 
                   12877:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   12878:                             if ($oldend > 0 && $oldend <= $now) {
                   12879:                                 $expire_role_result = 'ok';
                   12880:                             }
                   12881:                         }
                   12882:                     }
                   12883:                 }
1.443     albertel 12884:                 $result = $expire_role_result;
                   12885:             }
                   12886:         }
                   12887:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.652     raeburn  12888:             $modify_section_result = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,undef,undef,$sec,$end,$start,'','',$cid,'',$context);
1.443     albertel 12889:             if ($modify_section_result =~ /^ok/) {
                   12890:                 if ($secchange == 1) {
1.628     raeburn  12891:                     if ($sec eq '') {
                   12892:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   12893:                     } else {
                   12894:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   12895:                     }
1.443     albertel 12896:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  12897:                     if ($sec eq '') {
                   12898:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   12899:                     } else {
                   12900:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   12901:                     }
1.443     albertel 12902:                 } else {
1.628     raeburn  12903:                     if ($sec eq '') {
                   12904:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   12905:                     } else {
                   12906:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   12907:                     }
1.443     albertel 12908:                 }
                   12909:             } else {
1.628     raeburn  12910:                 if ($secchange) {       
                   12911:                     $$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;
                   12912:                 } else {
                   12913:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   12914:                 }
1.443     albertel 12915:             }
                   12916:             $result = $modify_section_result;
                   12917:         } elsif ($secchange == 1) {
1.628     raeburn  12918:             if ($oldsec eq '') {
                   12919:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_3] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
                   12920:             } else {
                   12921:                 $$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;
                   12922:             }
1.626     raeburn  12923:             if ($expire_role_result eq 'refused') {
                   12924:                 my $newsecurl = '/'.$cid;
                   12925:                 $newsecurl =~ s/\_/\//g;
                   12926:                 if ($sec ne '') {
                   12927:                     $newsecurl.='/'.$sec;
                   12928:                 }
                   12929:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   12930:                     if ($sec eq '') {
                   12931:                         $$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;
                   12932:                     } else {
                   12933:                         $$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;
                   12934:                     }
                   12935:                 }
                   12936:             }
1.443     albertel 12937:         }
                   12938:     } else {
1.626     raeburn  12939:         $$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 12940:         $result = "error: incomplete course id\n";
                   12941:     }
                   12942:     return $result;
                   12943: }
                   12944: 
                   12945: ############################################################
                   12946: ############################################################
                   12947: 
1.566     albertel 12948: sub check_clone {
1.578     raeburn  12949:     my ($args,$linefeed) = @_;
1.566     albertel 12950:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   12951:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   12952:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   12953:     my $clonemsg;
                   12954:     my $can_clone = 0;
1.944     raeburn  12955:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  12956:     if ($lctype ne 'community') {
                   12957:         $lctype = 'course';
                   12958:     }
1.566     albertel 12959:     if ($clonehome eq 'no_host') {
1.944     raeburn  12960:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  12961:             $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'});
                   12962:         } else {
                   12963:             $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'});
                   12964:         }     
1.566     albertel 12965:     } else {
                   12966: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  12967:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  12968:             if ($clonedesc{'type'} ne 'Community') {
                   12969:                  $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'});
                   12970:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   12971:             }
                   12972:         }
1.882     raeburn  12973: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   12974:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 12975: 	    $can_clone = 1;
                   12976: 	} else {
                   12977: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   12978: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   12979: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  12980:             if (grep(/^\*$/,@cloners)) {
                   12981:                 $can_clone = 1;
                   12982:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   12983:                 $can_clone = 1;
                   12984:             } else {
1.908     raeburn  12985:                 my $ccrole = 'cc';
1.944     raeburn  12986:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  12987:                     $ccrole = 'co';
                   12988:                 }
1.578     raeburn  12989: 	        my %roleshash =
                   12990: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   12991: 					 $args->{'ccdomain'},
1.908     raeburn  12992:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  12993: 					 [$args->{'clonedomain'}]);
1.908     raeburn  12994: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  12995:                     $can_clone = 1;
                   12996:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   12997:                     $can_clone = 1;
                   12998:                 } else {
1.944     raeburn  12999:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13000:                         $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'});
                   13001:                     } else {
                   13002:                         $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'});
                   13003:                     }
1.578     raeburn  13004: 	        }
1.566     albertel 13005: 	    }
1.578     raeburn  13006:         }
1.566     albertel 13007:     }
                   13008:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13009: }
                   13010: 
1.444     albertel 13011: sub construct_course {
1.885     raeburn  13012:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 13013:     my $outcome;
1.541     raeburn  13014:     my $linefeed =  '<br />'."\n";
                   13015:     if ($context eq 'auto') {
                   13016:         $linefeed = "\n";
                   13017:     }
1.566     albertel 13018: 
                   13019: #
                   13020: # Are we cloning?
                   13021: #
                   13022:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13023:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13024: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13025: 	if ($context ne 'auto') {
1.578     raeburn  13026:             if ($clonemsg ne '') {
                   13027: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13028:             }
1.566     albertel 13029: 	}
                   13030: 	$outcome .= $clonemsg.$linefeed;
                   13031: 
                   13032:         if (!$can_clone) {
                   13033: 	    return (0,$outcome);
                   13034: 	}
                   13035:     }
                   13036: 
1.444     albertel 13037: #
                   13038: # Open course
                   13039: #
                   13040:     my $crstype = lc($args->{'crstype'});
                   13041:     my %cenv=();
                   13042:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13043:                                              $args->{'cdescr'},
                   13044:                                              $args->{'curl'},
                   13045:                                              $args->{'course_home'},
                   13046:                                              $args->{'nonstandard'},
                   13047:                                              $args->{'crscode'},
                   13048:                                              $args->{'ccuname'}.':'.
                   13049:                                              $args->{'ccdomain'},
1.882     raeburn  13050:                                              $args->{'crstype'},
1.885     raeburn  13051:                                              $cnum,$context,$category);
1.444     albertel 13052: 
                   13053:     # Note: The testing routines depend on this being output; see 
                   13054:     # Utils::Course. This needs to at least be output as a comment
                   13055:     # if anyone ever decides to not show this, and Utils::Course::new
                   13056:     # will need to be suitably modified.
1.541     raeburn  13057:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13058:     if ($$courseid =~ /^error:/) {
                   13059:         return (0,$outcome);
                   13060:     }
                   13061: 
1.444     albertel 13062: #
                   13063: # Check if created correctly
                   13064: #
1.479     albertel 13065:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13066:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13067:     if ($crsuhome eq 'no_host') {
                   13068:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13069:         return (0,$outcome);
                   13070:     }
1.541     raeburn  13071:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13072: 
1.444     albertel 13073: #
1.566     albertel 13074: # Do the cloning
                   13075: #   
                   13076:     if ($can_clone && $cloneid) {
                   13077: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13078: 	if ($context ne 'auto') {
                   13079: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13080: 	}
                   13081: 	$outcome .= $clonemsg.$linefeed;
                   13082: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13083: # Copy all files
1.637     www      13084: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 13085: # Restore URL
1.566     albertel 13086: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 13087: # Restore title
1.566     albertel 13088: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  13089: # Restore creation date, creator and creation context.
                   13090:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   13091:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   13092:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 13093: # Mark as cloned
1.566     albertel 13094: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      13095: # Need to clone grading mode
                   13096:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   13097:         $cenv{'grading'}=$newenv{'grading'};
                   13098: # Do not clone these environment entries
                   13099:         &Apache::lonnet::del('environment',
                   13100:                   ['default_enrollment_start_date',
                   13101:                    'default_enrollment_end_date',
                   13102:                    'question.email',
                   13103:                    'policy.email',
                   13104:                    'comment.email',
                   13105:                    'pch.users.denied',
1.725     raeburn  13106:                    'plc.users.denied',
                   13107:                    'hidefromcat',
                   13108:                    'categories'],
1.638     www      13109:                    $$crsudom,$$crsunum);
1.444     albertel 13110:     }
1.566     albertel 13111: 
1.444     albertel 13112: #
                   13113: # Set environment (will override cloned, if existing)
                   13114: #
                   13115:     my @sections = ();
                   13116:     my @xlists = ();
                   13117:     if ($args->{'crstype'}) {
                   13118:         $cenv{'type'}=$args->{'crstype'};
                   13119:     }
                   13120:     if ($args->{'crsid'}) {
                   13121:         $cenv{'courseid'}=$args->{'crsid'};
                   13122:     }
                   13123:     if ($args->{'crscode'}) {
                   13124:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   13125:     }
                   13126:     if ($args->{'crsquota'} ne '') {
                   13127:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   13128:     } else {
                   13129:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   13130:     }
                   13131:     if ($args->{'ccuname'}) {
                   13132:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   13133:                                         ':'.$args->{'ccdomain'};
                   13134:     } else {
                   13135:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   13136:     }
                   13137:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   13138:     if ($args->{'crssections'}) {
                   13139:         $cenv{'internal.sectionnums'} = '';
                   13140:         if ($args->{'crssections'} =~ m/,/) {
                   13141:             @sections = split/,/,$args->{'crssections'};
                   13142:         } else {
                   13143:             $sections[0] = $args->{'crssections'};
                   13144:         }
                   13145:         if (@sections > 0) {
                   13146:             foreach my $item (@sections) {
                   13147:                 my ($sec,$gp) = split/:/,$item;
                   13148:                 my $class = $args->{'crscode'}.$sec;
                   13149:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   13150:                 $cenv{'internal.sectionnums'} .= $item.',';
                   13151:                 unless ($addcheck eq 'ok') {
                   13152:                     push @badclasses, $class;
                   13153:                 }
                   13154:             }
                   13155:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   13156:         }
                   13157:     }
                   13158: # do not hide course coordinator from staff listing, 
                   13159: # even if privileged
                   13160:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13161: # add crosslistings
                   13162:     if ($args->{'crsxlist'}) {
                   13163:         $cenv{'internal.crosslistings'}='';
                   13164:         if ($args->{'crsxlist'} =~ m/,/) {
                   13165:             @xlists = split/,/,$args->{'crsxlist'};
                   13166:         } else {
                   13167:             $xlists[0] = $args->{'crsxlist'};
                   13168:         }
                   13169:         if (@xlists > 0) {
                   13170:             foreach my $item (@xlists) {
                   13171:                 my ($xl,$gp) = split/:/,$item;
                   13172:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   13173:                 $cenv{'internal.crosslistings'} .= $item.',';
                   13174:                 unless ($addcheck eq 'ok') {
                   13175:                     push @badclasses, $xl;
                   13176:                 }
                   13177:             }
                   13178:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   13179:         }
                   13180:     }
                   13181:     if ($args->{'autoadds'}) {
                   13182:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   13183:     }
                   13184:     if ($args->{'autodrops'}) {
                   13185:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   13186:     }
                   13187: # check for notification of enrollment changes
                   13188:     my @notified = ();
                   13189:     if ($args->{'notify_owner'}) {
                   13190:         if ($args->{'ccuname'} ne '') {
                   13191:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   13192:         }
                   13193:     }
                   13194:     if ($args->{'notify_dc'}) {
                   13195:         if ($uname ne '') { 
1.630     raeburn  13196:             push(@notified,$uname.':'.$udom);
1.444     albertel 13197:         }
                   13198:     }
                   13199:     if (@notified > 0) {
                   13200:         my $notifylist;
                   13201:         if (@notified > 1) {
                   13202:             $notifylist = join(',',@notified);
                   13203:         } else {
                   13204:             $notifylist = $notified[0];
                   13205:         }
                   13206:         $cenv{'internal.notifylist'} = $notifylist;
                   13207:     }
                   13208:     if (@badclasses > 0) {
                   13209:         my %lt=&Apache::lonlocal::texthash(
                   13210:                 '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',
                   13211:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   13212:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   13213:         );
1.541     raeburn  13214:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   13215:                            ' ('.$lt{'adby'}.')';
                   13216:         if ($context eq 'auto') {
                   13217:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 13218:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  13219:             foreach my $item (@badclasses) {
                   13220:                 if ($context eq 'auto') {
                   13221:                     $outcome .= " - $item\n";
                   13222:                 } else {
                   13223:                     $outcome .= "<li>$item</li>\n";
                   13224:                 }
                   13225:             }
                   13226:             if ($context eq 'auto') {
                   13227:                 $outcome .= $linefeed;
                   13228:             } else {
1.566     albertel 13229:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  13230:             }
                   13231:         } 
1.444     albertel 13232:     }
                   13233:     if ($args->{'no_end_date'}) {
                   13234:         $args->{'endaccess'} = 0;
                   13235:     }
                   13236:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   13237:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   13238:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   13239:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   13240:     if ($args->{'showphotos'}) {
                   13241:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   13242:     }
                   13243:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   13244:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   13245:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   13246:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  13247:             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'); 
                   13248:             if ($context eq 'auto') {
                   13249:                 $outcome .= $krb_msg;
                   13250:             } else {
1.566     albertel 13251:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  13252:             }
                   13253:             $outcome .= $linefeed;
1.444     albertel 13254:         }
                   13255:     }
                   13256:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   13257:        if ($args->{'setpolicy'}) {
                   13258:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13259:        }
                   13260:        if ($args->{'setcontent'}) {
                   13261:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   13262:        }
                   13263:     }
                   13264:     if ($args->{'reshome'}) {
                   13265: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   13266: 	$cenv{'reshome'}=~s/\/+$/\//;
                   13267:     }
                   13268: #
                   13269: # course has keyed access
                   13270: #
                   13271:     if ($args->{'setkeys'}) {
                   13272:        $cenv{'keyaccess'}='yes';
                   13273:     }
                   13274: # if specified, key authority is not course, but user
                   13275: # only active if keyaccess is yes
                   13276:     if ($args->{'keyauth'}) {
1.487     albertel 13277: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   13278: 	$user = &LONCAPA::clean_username($user);
                   13279: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     13280: 	if ($user ne '' && $domain ne '') {
1.487     albertel 13281: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 13282: 	}
                   13283:     }
                   13284: 
                   13285:     if ($args->{'disresdis'}) {
                   13286:         $cenv{'pch.roles.denied'}='st';
                   13287:     }
                   13288:     if ($args->{'disablechat'}) {
                   13289:         $cenv{'plc.roles.denied'}='st';
                   13290:     }
                   13291: 
                   13292:     # Record we've not yet viewed the Course Initialization Helper for this 
                   13293:     # course
                   13294:     $cenv{'course.helper.not.run'} = 1;
                   13295:     #
                   13296:     # Use new Randomseed
                   13297:     #
                   13298:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   13299:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   13300:     #
                   13301:     # The encryption code and receipt prefix for this course
                   13302:     #
                   13303:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   13304:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   13305:     #
                   13306:     # By default, use standard grading
                   13307:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   13308: 
1.541     raeburn  13309:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   13310:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13311: #
                   13312: # Open all assignments
                   13313: #
                   13314:     if ($args->{'openall'}) {
                   13315:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   13316:        my %storecontent = ($storeunder         => time,
                   13317:                            $storeunder.'.type' => 'date_start');
                   13318:        
                   13319:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  13320:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 13321:    }
                   13322: #
                   13323: # Set first page
                   13324: #
                   13325:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   13326: 	    || ($cloneid)) {
1.445     albertel 13327: 	use LONCAPA::map;
1.444     albertel 13328: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 13329: 
                   13330: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   13331:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   13332: 
1.444     albertel 13333:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   13334:         my $title; my $url;
                   13335:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   13336: 	    $title=&mt('Syllabus');
1.444     albertel 13337:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   13338:         } else {
1.963     raeburn  13339:             $title=&mt('Table of Contents');
1.444     albertel 13340:             $url='/adm/navmaps';
                   13341:         }
1.445     albertel 13342: 
                   13343:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   13344: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   13345: 
                   13346: 	if ($errtext) { $fatal=2; }
1.541     raeburn  13347:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 13348:     }
1.566     albertel 13349: 
                   13350:     return (1,$outcome);
1.444     albertel 13351: }
                   13352: 
                   13353: ############################################################
                   13354: ############################################################
                   13355: 
1.953     droeschl 13356: #SD
                   13357: # only Community and Course, or anything else?
1.378     raeburn  13358: sub course_type {
                   13359:     my ($cid) = @_;
                   13360:     if (!defined($cid)) {
                   13361:         $cid = $env{'request.course.id'};
                   13362:     }
1.404     albertel 13363:     if (defined($env{'course.'.$cid.'.type'})) {
                   13364:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  13365:     } else {
                   13366:         return 'Course';
1.377     raeburn  13367:     }
                   13368: }
1.156     albertel 13369: 
1.406     raeburn  13370: sub group_term {
                   13371:     my $crstype = &course_type();
                   13372:     my %names = (
                   13373:                   'Course' => 'group',
1.865     raeburn  13374:                   'Community' => 'group',
1.406     raeburn  13375:                 );
                   13376:     return $names{$crstype};
                   13377: }
                   13378: 
1.902     raeburn  13379: sub course_types {
                   13380:     my @types = ('official','unofficial','community');
                   13381:     my %typename = (
                   13382:                          official   => 'Official course',
                   13383:                          unofficial => 'Unofficial course',
                   13384:                          community  => 'Community',
                   13385:                    );
                   13386:     return (\@types,\%typename);
                   13387: }
                   13388: 
1.156     albertel 13389: sub icon {
                   13390:     my ($file)=@_;
1.505     albertel 13391:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 13392:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 13393:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 13394:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   13395: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   13396: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13397: 	            $curfext.".gif") {
                   13398: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   13399: 		$curfext.".gif";
                   13400: 	}
                   13401:     }
1.249     albertel 13402:     return &lonhttpdurl($iconname);
1.154     albertel 13403: } 
1.84      albertel 13404: 
1.575     albertel 13405: sub lonhttpdurl {
1.692     www      13406: #
                   13407: # Had been used for "small fry" static images on separate port 8080.
                   13408: # Modify here if lightweight http functionality desired again.
                   13409: # Currently eliminated due to increasing firewall issues.
                   13410: #
1.575     albertel 13411:     my ($url)=@_;
1.692     www      13412:     return $url;
1.215     albertel 13413: }
                   13414: 
1.213     albertel 13415: sub connection_aborted {
                   13416:     my ($r)=@_;
                   13417:     $r->print(" ");$r->rflush();
                   13418:     my $c = $r->connection;
                   13419:     return $c->aborted();
                   13420: }
                   13421: 
1.221     foxr     13422: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     13423: #    strings as 'strings'.
                   13424: sub escape_single {
1.221     foxr     13425:     my ($input) = @_;
1.223     albertel 13426:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     13427:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   13428:     return $input;
                   13429: }
1.223     albertel 13430: 
1.222     foxr     13431: #  Same as escape_single, but escape's "'s  This 
                   13432: #  can be used for  "strings"
                   13433: sub escape_double {
                   13434:     my ($input) = @_;
                   13435:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   13436:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   13437:     return $input;
                   13438: }
1.223     albertel 13439:  
1.222     foxr     13440: #   Escapes the last element of a full URL.
                   13441: sub escape_url {
                   13442:     my ($url)   = @_;
1.238     raeburn  13443:     my @urlslices = split(/\//, $url,-1);
1.369     www      13444:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 13445:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     13446: }
1.462     albertel 13447: 
1.820     raeburn  13448: sub compare_arrays {
                   13449:     my ($arrayref1,$arrayref2) = @_;
                   13450:     my (@difference,%count);
                   13451:     @difference = ();
                   13452:     %count = ();
                   13453:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   13454:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   13455:         foreach my $element (keys(%count)) {
                   13456:             if ($count{$element} == 1) {
                   13457:                 push(@difference,$element);
                   13458:             }
                   13459:         }
                   13460:     }
                   13461:     return @difference;
                   13462: }
                   13463: 
1.817     bisitz   13464: # -------------------------------------------------------- Initialize user login
1.462     albertel 13465: sub init_user_environment {
1.463     albertel 13466:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 13467:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   13468: 
                   13469:     my $public=($username eq 'public' && $domain eq 'public');
                   13470: 
                   13471: # See if old ID present, if so, remove
                   13472: 
1.1062    raeburn  13473:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 13474:     my $now=time;
                   13475: 
                   13476:     if ($public) {
                   13477: 	my $max_public=100;
                   13478: 	my $oldest;
                   13479: 	my $oldest_time=0;
                   13480: 	for(my $next=1;$next<=$max_public;$next++) {
                   13481: 	    if (-e $lonids."/publicuser_$next.id") {
                   13482: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   13483: 		if ($mtime<$oldest_time || !$oldest_time) {
                   13484: 		    $oldest_time=$mtime;
                   13485: 		    $oldest=$next;
                   13486: 		}
                   13487: 	    } else {
                   13488: 		$cookie="publicuser_$next";
                   13489: 		last;
                   13490: 	    }
                   13491: 	}
                   13492: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   13493:     } else {
1.463     albertel 13494: 	# if this isn't a robot, kill any existing non-robot sessions
                   13495: 	if (!$args->{'robot'}) {
                   13496: 	    opendir(DIR,$lonids);
                   13497: 	    while ($filename=readdir(DIR)) {
                   13498: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   13499: 		    unlink($lonids.'/'.$filename);
                   13500: 		}
1.462     albertel 13501: 	    }
1.463     albertel 13502: 	    closedir(DIR);
1.462     albertel 13503: 	}
                   13504: # Give them a new cookie
1.463     albertel 13505: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      13506: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 13507: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 13508:     
                   13509: # Initialize roles
                   13510: 
1.1062    raeburn  13511: 	($userroles,$firstaccenv,$timerintenv) = 
                   13512:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 13513:     }
                   13514: # ------------------------------------ Check browser type and MathML capability
                   13515: 
                   13516:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
                   13517:         $clientunicode,$clientos) = &decode_user_agent($r);
                   13518: 
                   13519: # ------------------------------------------------------------- Get environment
                   13520: 
                   13521:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   13522:     my ($tmp) = keys(%userenv);
                   13523:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   13524:     } else {
                   13525: 	undef(%userenv);
                   13526:     }
                   13527:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   13528: 	$form->{'interface'}=$userenv{'interface'};
                   13529:     }
                   13530:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   13531: 
                   13532: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   13533:     foreach my $option ('interface','localpath','localres') {
                   13534:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 13535:     }
                   13536: # --------------------------------------------------------- Write first profile
                   13537: 
                   13538:     {
                   13539: 	my %initial_env = 
                   13540: 	    ("user.name"          => $username,
                   13541: 	     "user.domain"        => $domain,
                   13542: 	     "user.home"          => $authhost,
                   13543: 	     "browser.type"       => $clientbrowser,
                   13544: 	     "browser.version"    => $clientversion,
                   13545: 	     "browser.mathml"     => $clientmathml,
                   13546: 	     "browser.unicode"    => $clientunicode,
                   13547: 	     "browser.os"         => $clientos,
                   13548: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   13549: 	     "request.course.fn"  => '',
                   13550: 	     "request.course.uri" => '',
                   13551: 	     "request.course.sec" => '',
                   13552: 	     "request.role"       => 'cm',
                   13553: 	     "request.role.adv"   => $env{'user.adv'},
                   13554: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   13555: 
                   13556:         if ($form->{'localpath'}) {
                   13557: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   13558: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   13559:         }
                   13560: 	
                   13561: 	if ($form->{'interface'}) {
                   13562: 	    $form->{'interface'}=~s/\W//gs;
                   13563: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   13564: 	    $env{'browser.interface'}=$form->{'interface'};
                   13565: 	}
                   13566: 
1.981     raeburn  13567:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  13568:         my %domdef;
                   13569:         unless ($domain eq 'public') {
                   13570:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   13571:         }
1.980     raeburn  13572: 
1.724     raeburn  13573:         foreach my $tool ('aboutme','blog','portfolio') {
                   13574:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  13575:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   13576:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  13577:         }
                   13578: 
1.864     raeburn  13579:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  13580:             $userenv{'canrequest.'.$crstype} =
                   13581:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  13582:                                                   'reload','requestcourses',
                   13583:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  13584:         }
                   13585: 
1.462     albertel 13586: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  13587: 
1.462     albertel 13588: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   13589: 		 &GDBM_WRCREAT(),0640)) {
                   13590: 	    &_add_to_env(\%disk_env,\%initial_env);
                   13591: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   13592: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  13593:             if (ref($firstaccenv) eq 'HASH') {
                   13594:                 &_add_to_env(\%disk_env,$firstaccenv);
                   13595:             }
                   13596:             if (ref($timerintenv) eq 'HASH') {
                   13597:                 &_add_to_env(\%disk_env,$timerintenv);
                   13598:             }
1.463     albertel 13599: 	    if (ref($args->{'extra_env'})) {
                   13600: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   13601: 	    }
1.462     albertel 13602: 	    untie(%disk_env);
                   13603: 	} else {
1.705     tempelho 13604: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   13605: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 13606: 	    return 'error: '.$!;
                   13607: 	}
                   13608:     }
                   13609:     $env{'request.role'}='cm';
                   13610:     $env{'request.role.adv'}=$env{'user.adv'};
                   13611:     $env{'browser.type'}=$clientbrowser;
                   13612: 
                   13613:     return $cookie;
                   13614: 
                   13615: }
                   13616: 
                   13617: sub _add_to_env {
                   13618:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  13619:     if (ref($env_data) eq 'HASH') {
                   13620:         while (my ($key,$value) = each(%$env_data)) {
                   13621: 	    $idf->{$prefix.$key} = $value;
                   13622: 	    $env{$prefix.$key}   = $value;
                   13623:         }
1.462     albertel 13624:     }
                   13625: }
                   13626: 
1.685     tempelho 13627: # --- Get the symbolic name of a problem and the url
                   13628: sub get_symb {
                   13629:     my ($request,$silent) = @_;
1.726     raeburn  13630:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 13631:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   13632:     if ($symb eq '') {
                   13633:         if (!$silent) {
1.1071    raeburn  13634:             if (ref($request)) { 
                   13635:                 $request->print("Unable to handle ambiguous references:$url:.");
                   13636:             }
1.685     tempelho 13637:             return ();
                   13638:         }
                   13639:     }
                   13640:     &Apache::lonenc::check_decrypt(\$symb);
                   13641:     return ($symb);
                   13642: }
                   13643: 
                   13644: # --------------------------------------------------------------Get annotation
                   13645: 
                   13646: sub get_annotation {
                   13647:     my ($symb,$enc) = @_;
                   13648: 
                   13649:     my $key = $symb;
                   13650:     if (!$enc) {
                   13651:         $key =
                   13652:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   13653:     }
                   13654:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   13655:     return $annotation{$key};
                   13656: }
                   13657: 
                   13658: sub clean_symb {
1.731     raeburn  13659:     my ($symb,$delete_enc) = @_;
1.685     tempelho 13660: 
                   13661:     &Apache::lonenc::check_decrypt(\$symb);
                   13662:     my $enc = $env{'request.enc'};
1.731     raeburn  13663:     if ($delete_enc) {
1.730     raeburn  13664:         delete($env{'request.enc'});
                   13665:     }
1.685     tempelho 13666: 
                   13667:     return ($symb,$enc);
                   13668: }
1.462     albertel 13669: 
1.990     raeburn  13670: sub build_release_hashes {
                   13671:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   13672:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   13673:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   13674:                   (ref($randomizetry) eq 'HASH'));
                   13675:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   13676:         my ($item,$name,$value) = split(/:/,$key);
                   13677:         if ($item eq 'parameter') {
                   13678:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   13679:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   13680:                     push(@{$checkparms->{$name}},$value);
                   13681:                 }
                   13682:             } else {
                   13683:                 push(@{$checkparms->{$name}},$value);
                   13684:             }
                   13685:         } elsif ($item eq 'resourcetag') {
                   13686:             if ($name eq 'responsetype') {
                   13687:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   13688:             }
                   13689:         } elsif ($item eq 'course') {
                   13690:             if ($name eq 'crstype') {
                   13691:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   13692:             }
                   13693:         }
                   13694:     }
                   13695:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   13696:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   13697:     return;
                   13698: }
                   13699: 
1.41      ng       13700: =pod
                   13701: 
                   13702: =back
                   13703: 
1.112     bowersj2 13704: =cut
1.41      ng       13705: 
1.112     bowersj2 13706: 1;
                   13707: __END__;
1.41      ng       13708: 

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