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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1143  ! raeburn     4: # $Id: loncommon.pm,v 1.1142 2013/07/22 20:50:01 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.1108    raeburn    70: use Apache::lonuserutils();
1.1110    raeburn    71: use Apache::lonuserstate();
1.479     albertel   72: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    73: use DateTime::TimeZone;
1.687     raeburn    74: use DateTime::Locale::Catalog;
1.1091    foxr       75: use Text::Aspell;
1.1094    raeburn    76: use Authen::Captcha;
                     77: use Captcha::reCAPTCHA;
1.117     www        78: 
1.517     raeburn    79: # ---------------------------------------------- Designs
                     80: use vars qw(%defaultdesign);
                     81: 
1.22      www        82: my $readit;
                     83: 
1.517     raeburn    84: 
1.157     matthew    85: ##
                     86: ## Global Variables
                     87: ##
1.46      matthew    88: 
1.643     foxr       89: 
                     90: # ----------------------------------------------- SSI with retries:
                     91: #
                     92: 
                     93: =pod
                     94: 
1.648     raeburn    95: =head1 Server Side include with retries:
1.643     foxr       96: 
                     97: =over 4
                     98: 
1.648     raeburn    99: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      100: 
                    101: Performs an ssi with some number of retries.  Retries continue either
                    102: until the result is ok or until the retry count supplied by the
                    103: caller is exhausted.  
                    104: 
                    105: Inputs:
1.648     raeburn   106: 
                    107: =over 4
                    108: 
1.643     foxr      109: resource   - Identifies the resource to insert.
1.648     raeburn   110: 
1.643     foxr      111: retries    - Count of the number of retries allowed.
1.648     raeburn   112: 
1.643     foxr      113: form       - Hash that identifies the rendering options.
                    114: 
1.648     raeburn   115: =back
                    116: 
                    117: Returns:
                    118: 
                    119: =over 4
                    120: 
1.643     foxr      121: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   122: 
1.643     foxr      123: response   - The response from the last attempt (which may or may not have been successful.
                    124: 
1.648     raeburn   125: =back
                    126: 
                    127: =back
                    128: 
1.643     foxr      129: =cut
                    130: 
                    131: sub ssi_with_retries {
                    132:     my ($resource, $retries, %form) = @_;
                    133: 
                    134: 
                    135:     my $ok = 0;			# True if we got a good response.
                    136:     my $content;
                    137:     my $response;
                    138: 
                    139:     # Try to get the ssi done. within the retries count:
                    140: 
                    141:     do {
                    142: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    143: 	$ok      = $response->is_success;
1.650     www       144:         if (!$ok) {
                    145:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    146:         }
1.643     foxr      147: 	$retries--;
                    148:     } while (!$ok && ($retries > 0));
                    149: 
                    150:     if (!$ok) {
                    151: 	$content = '';		# On error return an empty content.
                    152:     }
                    153:     return ($content, $response);
                    154: 
                    155: }
                    156: 
                    157: 
                    158: 
1.20      www       159: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  160: my %language;
1.124     www       161: my %supported_language;
1.1088    foxr      162: my %supported_codes;
1.1048    foxr      163: my %latex_language;		# For choosing hyphenation in <transl..>
                    164: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  165: my %cprtag;
1.192     taceyjo1  166: my %scprtag;
1.351     www       167: my %fe; my %fd; my %fm;
1.41      ng        168: my %category_extensions;
1.12      harris41  169: 
1.46      matthew   170: # ---------------------------------------------- Thesaurus variables
1.144     matthew   171: #
                    172: # %Keywords:
                    173: #      A hash used by &keyword to determine if a word is considered a keyword.
                    174: # $thesaurus_db_file 
                    175: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   176: 
                    177: my %Keywords;
                    178: my $thesaurus_db_file;
                    179: 
1.144     matthew   180: #
                    181: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    182: # thesaurus.tab, and filecategories.tab.
                    183: #
1.18      www       184: BEGIN {
1.46      matthew   185:     # Variable initialization
                    186:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    187:     #
1.22      www       188:     unless ($readit) {
1.12      harris41  189: # ------------------------------------------------------------------- languages
                    190:     {
1.158     raeburn   191:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    192:                                    '/language.tab';
                    193:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  194:             while (my $line = <$fh>) {
                    195:                 next if ($line=~/^\#/);
                    196:                 chomp($line);
1.1088    foxr      197:                 my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   198:                 $language{$key}=$val.' - '.$enc;
                    199:                 if ($sup) {
                    200:                     $supported_language{$key}=$sup;
1.1088    foxr      201: 		    $supported_codes{$key}   = $code;
1.158     raeburn   202:                 }
1.1048    foxr      203: 		if ($latex) {
                    204: 		    $latex_language_bykey{$key} = $latex;
1.1088    foxr      205: 		    $latex_language{$code} = $latex;
1.1048    foxr      206: 		}
1.158     raeburn   207:             }
                    208:             close($fh);
                    209:         }
1.12      harris41  210:     }
                    211: # ------------------------------------------------------------------ copyrights
                    212:     {
1.158     raeburn   213:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    214:                                   '/copyright.tab';
                    215:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  216:             while (my $line = <$fh>) {
                    217:                 next if ($line=~/^\#/);
                    218:                 chomp($line);
                    219:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   220:                 $cprtag{$key}=$val;
                    221:             }
                    222:             close($fh);
                    223:         }
1.12      harris41  224:     }
1.351     www       225: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  226:     {
                    227:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    228:                                   '/source_copyright.tab';
                    229:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  230:             while (my $line = <$fh>) {
                    231:                 next if ($line =~ /^\#/);
                    232:                 chomp($line);
                    233:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  234:                 $scprtag{$key}=$val;
                    235:             }
                    236:             close($fh);
                    237:         }
                    238:     }
1.63      www       239: 
1.517     raeburn   240: # -------------------------------------------------------------- default domain designs
1.63      www       241:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   242:     my $designfile = $designdir.'/default.tab';
                    243:     if ( open (my $fh,"<$designfile") ) {
                    244:         while (my $line = <$fh>) {
                    245:             next if ($line =~ /^\#/);
                    246:             chomp($line);
                    247:             my ($key,$val)=(split(/\=/,$line));
                    248:             if ($val) { $defaultdesign{$key}=$val; }
                    249:         }
                    250:         close($fh);
1.63      www       251:     }
                    252: 
1.15      harris41  253: # ------------------------------------------------------------- file categories
                    254:     {
1.158     raeburn   255:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    256:                                   '/filecategories.tab';
                    257:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  258: 	    while (my $line = <$fh>) {
                    259: 		next if ($line =~ /^\#/);
                    260: 		chomp($line);
                    261:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   262:                 push @{$category_extensions{lc($category)}},$extension;
                    263:             }
                    264:             close($fh);
                    265:         }
                    266: 
1.15      harris41  267:     }
1.12      harris41  268: # ------------------------------------------------------------------ file types
                    269:     {
1.158     raeburn   270:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    271:                '/filetypes.tab';
                    272:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  273:             while (my $line = <$fh>) {
                    274: 		next if ($line =~ /^\#/);
                    275: 		chomp($line);
                    276:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   277:                 if ($descr ne '') {
                    278:                     $fe{$ending}=lc($emb);
                    279:                     $fd{$ending}=$descr;
1.351     www       280:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   281:                 }
                    282:             }
                    283:             close($fh);
                    284:         }
1.12      harris41  285:     }
1.22      www       286:     &Apache::lonnet::logthis(
1.705     tempelho  287:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       288:     $readit=1;
1.46      matthew   289:     }  # end of unless($readit) 
1.32      matthew   290:     
                    291: }
1.112     bowersj2  292: 
1.42      matthew   293: ###############################################################
                    294: ##           HTML and Javascript Helper Functions            ##
                    295: ###############################################################
                    296: 
                    297: =pod 
                    298: 
1.112     bowersj2  299: =head1 HTML and Javascript Functions
1.42      matthew   300: 
1.112     bowersj2  301: =over 4
                    302: 
1.648     raeburn   303: =item * &browser_and_searcher_javascript()
1.112     bowersj2  304: 
                    305: X<browsing, javascript>X<searching, javascript>Returns a string
                    306: containing javascript with two functions, C<openbrowser> and
                    307: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    308: tags.
1.42      matthew   309: 
1.648     raeburn   310: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   311: 
                    312: inputs: formname, elementname, only, omit
                    313: 
                    314: formname and elementname indicate the name of the html form and name of
                    315: the element that the results of the browsing selection are to be placed in. 
                    316: 
                    317: Specifying 'only' will restrict the browser to displaying only files
1.185     www       318: with the given extension.  Can be a comma separated list.
1.42      matthew   319: 
                    320: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       321: with the given extension.  Can be a comma separated list.
1.42      matthew   322: 
1.648     raeburn   323: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   324: 
                    325: Inputs: formname, elementname
                    326: 
                    327: formname and elementname specify the name of the html form and the name
                    328: of the element the selection from the search results will be placed in.
1.542     raeburn   329: 
1.42      matthew   330: =cut
                    331: 
                    332: sub browser_and_searcher_javascript {
1.199     albertel  333:     my ($mode)=@_;
                    334:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  335:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   336:     return <<END;
1.219     albertel  337: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   338:     var editbrowser = null;
1.135     albertel  339:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       340:         var url = '$resurl/?';
1.42      matthew   341:         if (editbrowser == null) {
                    342:             url += 'launch=1&';
                    343:         }
                    344:         url += 'catalogmode=interactive&';
1.199     albertel  345:         url += 'mode=$mode&';
1.611     albertel  346:         url += 'inhibitmenu=yes&';
1.42      matthew   347:         url += 'form=' + formname + '&';
                    348:         if (only != null) {
                    349:             url += 'only=' + only + '&';
1.217     albertel  350:         } else {
                    351:             url += 'only=&';
                    352: 	}
1.42      matthew   353:         if (omit != null) {
                    354:             url += 'omit=' + omit + '&';
1.217     albertel  355:         } else {
                    356:             url += 'omit=&';
                    357: 	}
1.135     albertel  358:         if (titleelement != null) {
                    359:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  360:         } else {
                    361: 	    url += 'titleelement=&';
                    362: 	}
1.42      matthew   363:         url += 'element=' + elementname + '';
                    364:         var title = 'Browser';
1.435     albertel  365:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   366:         options += ',width=700,height=600';
                    367:         editbrowser = open(url,title,options,'1');
                    368:         editbrowser.focus();
                    369:     }
                    370:     var editsearcher;
1.135     albertel  371:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   372:         var url = '/adm/searchcat?';
                    373:         if (editsearcher == null) {
                    374:             url += 'launch=1&';
                    375:         }
                    376:         url += 'catalogmode=interactive&';
1.199     albertel  377:         url += 'mode=$mode&';
1.42      matthew   378:         url += 'form=' + formname + '&';
1.135     albertel  379:         if (titleelement != null) {
                    380:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  381:         } else {
                    382: 	    url += 'titleelement=&';
                    383: 	}
1.42      matthew   384:         url += 'element=' + elementname + '';
                    385:         var title = 'Search';
1.435     albertel  386:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   387:         options += ',width=700,height=600';
                    388:         editsearcher = open(url,title,options,'1');
                    389:         editsearcher.focus();
                    390:     }
1.219     albertel  391: // END LON-CAPA Internal -->
1.42      matthew   392: END
1.170     www       393: }
                    394: 
                    395: sub lastresurl {
1.258     albertel  396:     if ($env{'environment.lastresurl'}) {
                    397: 	return $env{'environment.lastresurl'}
1.170     www       398:     } else {
                    399: 	return '/res';
                    400:     }
                    401: }
                    402: 
                    403: sub storeresurl {
                    404:     my $resurl=&Apache::lonnet::clutter(shift);
                    405:     unless ($resurl=~/^\/res/) { return 0; }
                    406:     $resurl=~s/\/$//;
                    407:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   408:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       409:     return 1;
1.42      matthew   410: }
                    411: 
1.74      www       412: sub studentbrowser_javascript {
1.111     www       413:    unless (
1.258     albertel  414:             (($env{'request.course.id'}) && 
1.302     albertel  415:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    416: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    417: 					  '/'.$env{'request.course.sec'})
                    418: 	      ))
1.258     albertel  419:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       420:           ) { return ''; }  
1.74      www       421:    return (<<'ENDSTDBRW');
1.776     bisitz    422: <script type="text/javascript" language="Javascript">
1.824     bisitz    423: // <![CDATA[
1.74      www       424:     var stdeditbrowser;
1.999     www       425:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       426:         var url = '/adm/pickstudent?';
                    427:         var filter;
1.558     albertel  428: 	if (!ignorefilter) {
                    429: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    430: 	}
1.74      www       431:         if (filter != null) {
                    432:            if (filter != '') {
                    433:                url += 'filter='+filter+'&';
                    434: 	   }
                    435:         }
                    436:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       437:                                     '&udomelement='+udom+
                    438:                                     '&clicker='+clicker;
1.111     www       439: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   440:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       441:         var title = 'Student_Browser';
1.74      www       442:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    443:         options += ',width=700,height=600';
                    444:         stdeditbrowser = open(url,title,options,'1');
                    445:         stdeditbrowser.focus();
                    446:     }
1.824     bisitz    447: // ]]>
1.74      www       448: </script>
                    449: ENDSTDBRW
                    450: }
1.42      matthew   451: 
1.1003    www       452: sub resourcebrowser_javascript {
                    453:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       454:    return (<<'ENDRESBRW');
1.1003    www       455: <script type="text/javascript" language="Javascript">
                    456: // <![CDATA[
                    457:     var reseditbrowser;
1.1004    www       458:     function openresbrowser(formname,reslink) {
1.1005    www       459:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       460:         var title = 'Resource_Browser';
                    461:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       462:         options += ',width=700,height=500';
1.1004    www       463:         reseditbrowser = open(url,title,options,'1');
                    464:         reseditbrowser.focus();
1.1003    www       465:     }
                    466: // ]]>
                    467: </script>
1.1004    www       468: ENDRESBRW
1.1003    www       469: }
                    470: 
1.74      www       471: sub selectstudent_link {
1.999     www       472:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    473:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    474:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    475:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  476:    if ($env{'request.course.id'}) {  
1.302     albertel  477:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    478: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    479: 					'/'.$env{'request.course.sec'})) {
1.111     www       480: 	   return '';
                    481:        }
1.999     www       482:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   483:        if ($courseadvonly)  {
                    484:            $callargs .= ",'',1,1";
                    485:        }
                    486:        return '<span class="LC_nobreak">'.
                    487:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    488:               &mt('Select User').'</a></span>';
1.74      www       489:    }
1.258     albertel  490:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       491:        $callargs .= ",'',1"; 
1.793     raeburn   492:        return '<span class="LC_nobreak">'.
                    493:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    494:               &mt('Select User').'</a></span>';
1.111     www       495:    }
                    496:    return '';
1.91      www       497: }
                    498: 
1.1004    www       499: sub selectresource_link {
                    500:    my ($form,$reslink,$arg)=@_;
                    501:    
                    502:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    503:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    504:    unless ($env{'request.course.id'}) { return $arg; }
                    505:    return '<span class="LC_nobreak">'.
                    506:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    507:               $arg.'</a></span>';
                    508: }
                    509: 
                    510: 
                    511: 
1.653     raeburn   512: sub authorbrowser_javascript {
                    513:     return <<"ENDAUTHORBRW";
1.776     bisitz    514: <script type="text/javascript" language="JavaScript">
1.824     bisitz    515: // <![CDATA[
1.653     raeburn   516: var stdeditbrowser;
                    517: 
                    518: function openauthorbrowser(formname,udom) {
                    519:     var url = '/adm/pickauthor?';
                    520:     url += 'form='+formname+'&roledom='+udom;
                    521:     var title = 'Author_Browser';
                    522:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    523:     options += ',width=700,height=600';
                    524:     stdeditbrowser = open(url,title,options,'1');
                    525:     stdeditbrowser.focus();
                    526: }
                    527: 
1.824     bisitz    528: // ]]>
1.653     raeburn   529: </script>
                    530: ENDAUTHORBRW
                    531: }
                    532: 
1.91      www       533: sub coursebrowser_javascript {
1.1116    raeburn   534:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
                    535:         $credits_element) = @_;
1.932     raeburn   536:     my $wintitle = 'Course_Browser';
1.931     raeburn   537:     if ($crstype eq 'Community') {
1.932     raeburn   538:         $wintitle = 'Community_Browser';
1.909     raeburn   539:     }
1.876     raeburn   540:     my $id_functions = &javascript_index_functions();
                    541:     my $output = '
1.776     bisitz    542: <script type="text/javascript" language="JavaScript">
1.824     bisitz    543: // <![CDATA[
1.468     raeburn   544:     var stdeditbrowser;'."\n";
1.876     raeburn   545: 
                    546:     $output .= <<"ENDSTDBRW";
1.909     raeburn   547:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       548:         var url = '/adm/pickcourse?';
1.895     raeburn   549:         var formid = getFormIdByName(formname);
1.876     raeburn   550:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  551:         if (domainfilter != null) {
                    552:            if (domainfilter != '') {
                    553:                url += 'domainfilter='+domainfilter+'&';
                    554: 	   }
                    555:         }
1.91      www       556:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  557: 	                            '&cdomelement='+udom+
                    558:                                     '&cnameelement='+desc;
1.468     raeburn   559:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   560:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   561:                 url += '&roleelement='+extra_element;
                    562:                 if (domainfilter == null || domainfilter == '') {
                    563:                     url += '&domainfilter='+extra_element;
                    564:                 }
1.234     raeburn   565:             }
1.468     raeburn   566:             else {
                    567:                 if (formname == 'portform') {
                    568:                     url += '&setroles='+extra_element;
1.800     raeburn   569:                 } else {
                    570:                     if (formname == 'rules') {
                    571:                         url += '&fixeddom='+extra_element; 
                    572:                     }
1.468     raeburn   573:                 }
                    574:             }     
1.230     raeburn   575:         }
1.909     raeburn   576:         if (type != null && type != '') {
                    577:             url += '&type='+type;
                    578:         }
                    579:         if (type_elem != null && type_elem != '') {
                    580:             url += '&typeelement='+type_elem;
                    581:         }
1.872     raeburn   582:         if (formname == 'ccrs') {
                    583:             var ownername = document.forms[formid].ccuname.value;
                    584:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    585:             url += '&cloner='+ownername+':'+ownerdom;
                    586:         }
1.293     raeburn   587:         if (multflag !=null && multflag != '') {
                    588:             url += '&multiple='+multflag;
                    589:         }
1.909     raeburn   590:         var title = '$wintitle';
1.91      www       591:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    592:         options += ',width=700,height=600';
                    593:         stdeditbrowser = open(url,title,options,'1');
                    594:         stdeditbrowser.focus();
                    595:     }
1.876     raeburn   596: $id_functions
                    597: ENDSTDBRW
1.1116    raeburn   598:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    599:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    600:                                       $credits_element);
1.876     raeburn   601:     }
                    602:     $output .= '
                    603: // ]]>
                    604: </script>';
                    605:     return $output;
                    606: }
                    607: 
                    608: sub javascript_index_functions {
                    609:     return <<"ENDJS";
                    610: 
                    611: function getFormIdByName(formname) {
                    612:     for (var i=0;i<document.forms.length;i++) {
                    613:         if (document.forms[i].name == formname) {
                    614:             return i;
                    615:         }
                    616:     }
                    617:     return -1;
                    618: }
                    619: 
                    620: function getIndexByName(formid,item) {
                    621:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    622:         if (document.forms[formid].elements[i].name == item) {
                    623:             return i;
                    624:         }
                    625:     }
                    626:     return -1;
                    627: }
1.468     raeburn   628: 
1.876     raeburn   629: function getDomainFromSelectbox(formname,udom) {
                    630:     var userdom;
                    631:     var formid = getFormIdByName(formname);
                    632:     if (formid > -1) {
                    633:         var domid = getIndexByName(formid,udom);
                    634:         if (domid > -1) {
                    635:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    636:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    637:             }
                    638:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    639:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   640:             }
                    641:         }
                    642:     }
1.876     raeburn   643:     return userdom;
                    644: }
                    645: 
                    646: ENDJS
1.468     raeburn   647: 
1.876     raeburn   648: }
                    649: 
1.1017    raeburn   650: sub javascript_array_indexof {
1.1018    raeburn   651:     return <<ENDJS;
1.1017    raeburn   652: <script type="text/javascript" language="JavaScript">
                    653: // <![CDATA[
                    654: 
                    655: if (!Array.prototype.indexOf) {
                    656:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    657:         "use strict";
                    658:         if (this === void 0 || this === null) {
                    659:             throw new TypeError();
                    660:         }
                    661:         var t = Object(this);
                    662:         var len = t.length >>> 0;
                    663:         if (len === 0) {
                    664:             return -1;
                    665:         }
                    666:         var n = 0;
                    667:         if (arguments.length > 0) {
                    668:             n = Number(arguments[1]);
1.1088    foxr      669:             if (n !== n) { // shortcut for verifying if it is NaN
1.1017    raeburn   670:                 n = 0;
                    671:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    672:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    673:             }
                    674:         }
                    675:         if (n >= len) {
                    676:             return -1;
                    677:         }
                    678:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    679:         for (; k < len; k++) {
                    680:             if (k in t && t[k] === searchElement) {
                    681:                 return k;
                    682:             }
                    683:         }
                    684:         return -1;
                    685:     }
                    686: }
                    687: 
                    688: // ]]>
                    689: </script>
                    690: 
                    691: ENDJS
                    692: 
                    693: }
                    694: 
1.876     raeburn   695: sub userbrowser_javascript {
                    696:     my $id_functions = &javascript_index_functions();
                    697:     return <<"ENDUSERBRW";
                    698: 
1.888     raeburn   699: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   700:     var url = '/adm/pickuser?';
                    701:     var userdom = getDomainFromSelectbox(formname,udom);
                    702:     if (userdom != null) {
                    703:        if (userdom != '') {
                    704:            url += 'srchdom='+userdom+'&';
                    705:        }
                    706:     }
                    707:     url += 'form=' + formname + '&unameelement='+uname+
                    708:                                 '&udomelement='+udom+
                    709:                                 '&ulastelement='+ulast+
                    710:                                 '&ufirstelement='+ufirst+
                    711:                                 '&uemailelement='+uemail+
1.881     raeburn   712:                                 '&hideudomelement='+hideudom+
                    713:                                 '&coursedom='+crsdom;
1.888     raeburn   714:     if ((caller != null) && (caller != undefined)) {
                    715:         url += '&caller='+caller;
                    716:     }
1.876     raeburn   717:     var title = 'User_Browser';
                    718:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    719:     options += ',width=700,height=600';
                    720:     var stdeditbrowser = open(url,title,options,'1');
                    721:     stdeditbrowser.focus();
                    722: }
                    723: 
1.888     raeburn   724: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   725:     var formid = getFormIdByName(formname);
                    726:     if (formid > -1) {
1.888     raeburn   727:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   728:         var domid = getIndexByName(formid,udom);
                    729:         var hidedomid = getIndexByName(formid,origdom);
                    730:         if (hidedomid > -1) {
                    731:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   732:             var unameval = document.forms[formid].elements[unameid].value;
                    733:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    734:                 if (domid > -1) {
                    735:                     var slct = document.forms[formid].elements[domid];
                    736:                     if (slct.type == 'select-one') {
                    737:                         var i;
                    738:                         for (i=0;i<slct.length;i++) {
                    739:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    740:                         }
                    741:                     }
                    742:                     if (slct.type == 'hidden') {
                    743:                         slct.value = fixeddom;
1.876     raeburn   744:                     }
                    745:                 }
1.468     raeburn   746:             }
                    747:         }
                    748:     }
1.876     raeburn   749:     return;
                    750: }
                    751: 
                    752: $id_functions
                    753: ENDUSERBRW
1.468     raeburn   754: }
                    755: 
                    756: sub setsec_javascript {
1.1116    raeburn   757:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   758:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    759:         $communityrolestr);
                    760:     if ($role_element ne '') {
                    761:         my @allroles = ('st','ta','ep','in','ad');
                    762:         foreach my $crstype ('Course','Community') {
                    763:             if ($crstype eq 'Community') {
                    764:                 foreach my $role (@allroles) {
                    765:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    766:                 }
                    767:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    768:             } else {
                    769:                 foreach my $role (@allroles) {
                    770:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    771:                 }
                    772:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    773:             }
                    774:         }
                    775:         $rolestr = '"'.join('","',@allroles).'"';
                    776:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    777:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    778:     }
1.468     raeburn   779:     my $setsections = qq|
                    780: function setSect(sectionlist) {
1.629     raeburn   781:     var sectionsArray = new Array();
                    782:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    783:         sectionsArray = sectionlist.split(",");
                    784:     }
1.468     raeburn   785:     var numSections = sectionsArray.length;
                    786:     document.$formname.$sec_element.length = 0;
                    787:     if (numSections == 0) {
                    788:         document.$formname.$sec_element.multiple=false;
                    789:         document.$formname.$sec_element.size=1;
                    790:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    791:     } else {
                    792:         if (numSections == 1) {
                    793:             document.$formname.$sec_element.multiple=false;
                    794:             document.$formname.$sec_element.size=1;
                    795:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    796:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    797:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    798:         } else {
                    799:             for (var i=0; i<numSections; i++) {
                    800:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    801:             }
                    802:             document.$formname.$sec_element.multiple=true
                    803:             if (numSections < 3) {
                    804:                 document.$formname.$sec_element.size=numSections;
                    805:             } else {
                    806:                 document.$formname.$sec_element.size=3;
                    807:             }
                    808:             document.$formname.$sec_element.options[0].selected = false
                    809:         }
                    810:     }
1.91      www       811: }
1.905     raeburn   812: 
                    813: function setRole(crstype) {
1.468     raeburn   814: |;
1.905     raeburn   815:     if ($role_element eq '') {
                    816:         $setsections .= '    return;
                    817: }
                    818: ';
                    819:     } else {
                    820:         $setsections .= qq|
                    821:     var elementLength = document.$formname.$role_element.length;
                    822:     var allroles = Array($rolestr);
                    823:     var courserolenames = Array($courserolestr);
                    824:     var communityrolenames = Array($communityrolestr);
                    825:     if (elementLength != undefined) {
                    826:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    827:             if (crstype == 'Course') {
                    828:                 return;
                    829:             } else {
                    830:                 allroles[5] = 'co';
                    831:                 for (var i=0; i<6; i++) {
                    832:                     document.$formname.$role_element.options[i].value = allroles[i];
                    833:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    834:                 }
                    835:             }
                    836:         } else {
                    837:             if (crstype == 'Community') {
                    838:                 return;
                    839:             } else {
                    840:                 allroles[5] = 'cc';
                    841:                 for (var i=0; i<6; i++) {
                    842:                     document.$formname.$role_element.options[i].value = allroles[i];
                    843:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    844:                 }
                    845:             }
                    846:         }
                    847:     }
                    848:     return;
                    849: }
                    850: |;
                    851:     }
1.1116    raeburn   852:     if ($credits_element) {
                    853:         $setsections .= qq|
                    854: function setCredits(defaultcredits) {
                    855:     document.$formname.$credits_element.value = defaultcredits;
                    856:     return;
                    857: }
                    858: |;
                    859:     }
1.468     raeburn   860:     return $setsections;
                    861: }
                    862: 
1.91      www       863: sub selectcourse_link {
1.909     raeburn   864:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    865:        $typeelement) = @_;
                    866:    my $type = $selecttype;
1.871     raeburn   867:    my $linktext = &mt('Select Course');
                    868:    if ($selecttype eq 'Community') {
1.909     raeburn   869:        $linktext = &mt('Select Community');
1.906     raeburn   870:    } elsif ($selecttype eq 'Course/Community') {
                    871:        $linktext = &mt('Select Course/Community');
1.909     raeburn   872:        $type = '';
1.1019    raeburn   873:    } elsif ($selecttype eq 'Select') {
                    874:        $linktext = &mt('Select');
                    875:        $type = '';
1.871     raeburn   876:    }
1.787     bisitz    877:    return '<span class="LC_nobreak">'
                    878:          ."<a href='"
                    879:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    880:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   881:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   882:          ."'>".$linktext.'</a>'
1.787     bisitz    883:          .'</span>';
1.74      www       884: }
1.42      matthew   885: 
1.653     raeburn   886: sub selectauthor_link {
                    887:    my ($form,$udom)=@_;
                    888:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    889:           &mt('Select Author').'</a>';
                    890: }
                    891: 
1.876     raeburn   892: sub selectuser_link {
1.881     raeburn   893:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   894:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   895:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   896:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   897:            ');">'.$linktext.'</a>';
1.876     raeburn   898: }
                    899: 
1.273     raeburn   900: sub check_uncheck_jscript {
                    901:     my $jscript = <<"ENDSCRT";
                    902: function checkAll(field) {
                    903:     if (field.length > 0) {
                    904:         for (i = 0; i < field.length; i++) {
1.1093    raeburn   905:             if (!field[i].disabled) { 
                    906:                 field[i].checked = true;
                    907:             }
1.273     raeburn   908:         }
                    909:     } else {
1.1093    raeburn   910:         if (!field.disabled) { 
                    911:             field.checked = true;
                    912:         }
1.273     raeburn   913:     }
                    914: }
                    915:  
                    916: function uncheckAll(field) {
                    917:     if (field.length > 0) {
                    918:         for (i = 0; i < field.length; i++) {
                    919:             field[i].checked = false ;
1.543     albertel  920:         }
                    921:     } else {
1.273     raeburn   922:         field.checked = false ;
                    923:     }
                    924: }
                    925: ENDSCRT
                    926:     return $jscript;
                    927: }
                    928: 
1.656     www       929: sub select_timezone {
1.659     raeburn   930:    my ($name,$selected,$onchange,$includeempty)=@_;
                    931:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    932:    if ($includeempty) {
                    933:        $output .= '<option value=""';
                    934:        if (($selected eq '') || ($selected eq 'local')) {
                    935:            $output .= ' selected="selected" ';
                    936:        }
                    937:        $output .= '> </option>';
                    938:    }
1.657     raeburn   939:    my @timezones = DateTime::TimeZone->all_names;
                    940:    foreach my $tzone (@timezones) {
                    941:        $output.= '<option value="'.$tzone.'"';
                    942:        if ($tzone eq $selected) {
                    943:            $output.=' selected="selected"';
                    944:        }
                    945:        $output.=">$tzone</option>\n";
1.656     www       946:    }
                    947:    $output.="</select>";
                    948:    return $output;
                    949: }
1.273     raeburn   950: 
1.687     raeburn   951: sub select_datelocale {
                    952:     my ($name,$selected,$onchange,$includeempty)=@_;
                    953:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    954:     if ($includeempty) {
                    955:         $output .= '<option value=""';
                    956:         if ($selected eq '') {
                    957:             $output .= ' selected="selected" ';
                    958:         }
                    959:         $output .= '> </option>';
                    960:     }
                    961:     my (@possibles,%locale_names);
                    962:     my @locales = DateTime::Locale::Catalog::Locales;
                    963:     foreach my $locale (@locales) {
                    964:         if (ref($locale) eq 'HASH') {
                    965:             my $id = $locale->{'id'};
                    966:             if ($id ne '') {
                    967:                 my $en_terr = $locale->{'en_territory'};
                    968:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   969:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   970:                 if (grep(/^en$/,@languages) || !@languages) {
                    971:                     if ($en_terr ne '') {
                    972:                         $locale_names{$id} = '('.$en_terr.')';
                    973:                     } elsif ($native_terr ne '') {
                    974:                         $locale_names{$id} = $native_terr;
                    975:                     }
                    976:                 } else {
                    977:                     if ($native_terr ne '') {
                    978:                         $locale_names{$id} = $native_terr.' ';
                    979:                     } elsif ($en_terr ne '') {
                    980:                         $locale_names{$id} = '('.$en_terr.')';
                    981:                     }
                    982:                 }
                    983:                 push (@possibles,$id);
                    984:             }
                    985:         }
                    986:     }
                    987:     foreach my $item (sort(@possibles)) {
                    988:         $output.= '<option value="'.$item.'"';
                    989:         if ($item eq $selected) {
                    990:             $output.=' selected="selected"';
                    991:         }
                    992:         $output.=">$item";
                    993:         if ($locale_names{$item} ne '') {
                    994:             $output.="  $locale_names{$item}</option>\n";
                    995:         }
                    996:         $output.="</option>\n";
                    997:     }
                    998:     $output.="</select>";
                    999:     return $output;
                   1000: }
                   1001: 
1.792     raeburn  1002: sub select_language {
                   1003:     my ($name,$selected,$includeempty) = @_;
                   1004:     my %langchoices;
                   1005:     if ($includeempty) {
1.1117    raeburn  1006:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1007:     }
                   1008:     foreach my $id (&languageids()) {
                   1009:         my $code = &supportedlanguagecode($id);
                   1010:         if ($code) {
                   1011:             $langchoices{$code} = &plainlanguagedescription($id);
                   1012:         }
                   1013:     }
1.1117    raeburn  1014:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970     raeburn  1015:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1016: }
                   1017: 
1.42      matthew  1018: =pod
1.36      matthew  1019: 
1.1088    foxr     1020: 
                   1021: =item * &list_languages()
                   1022: 
                   1023: Returns an array reference that is suitable for use in language prompters.
                   1024: Each array element is itself a two element array.  The first element
                   1025: is the language code.  The second element a descsriptiuon of the 
                   1026: language itself.  This is suitable for use in e.g.
                   1027: &Apache::edit::select_arg (once dereferenced that is).
                   1028: 
                   1029: =cut 
                   1030: 
                   1031: sub list_languages {
                   1032:     my @lang_choices;
                   1033: 
                   1034:     foreach my $id (&languageids()) {
                   1035: 	my $code = &supportedlanguagecode($id);
                   1036: 	if ($code) {
                   1037: 	    my $selector    = $supported_codes{$id};
                   1038: 	    my $description = &plainlanguagedescription($id);
                   1039: 	    push (@lang_choices, [$selector, $description]);
                   1040: 	}
                   1041:     }
                   1042:     return \@lang_choices;
                   1043: }
                   1044: 
                   1045: =pod
                   1046: 
1.648     raeburn  1047: =item * &linked_select_forms(...)
1.36      matthew  1048: 
                   1049: linked_select_forms returns a string containing a <script></script> block
                   1050: and html for two <select> menus.  The select menus will be linked in that
                   1051: changing the value of the first menu will result in new values being placed
                   1052: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1053: order unless a defined order is provided.
1.36      matthew  1054: 
                   1055: linked_select_forms takes the following ordered inputs:
                   1056: 
                   1057: =over 4
                   1058: 
1.112     bowersj2 1059: =item * $formname, the name of the <form> tag
1.36      matthew  1060: 
1.112     bowersj2 1061: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1062: 
1.112     bowersj2 1063: =item * $firstdefault, the default value for the first menu
1.36      matthew  1064: 
1.112     bowersj2 1065: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1066: 
1.112     bowersj2 1067: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1068: 
1.112     bowersj2 1069: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1070: 
1.609     raeburn  1071: =item * $menuorder, the order of values in the first menu
                   1072: 
1.1115    raeburn  1073: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1074:         event for the first <select> tag
                   1075: 
                   1076: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1077:         event for the second <select> tag
                   1078: 
1.41      ng       1079: =back 
                   1080: 
1.36      matthew  1081: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1082: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1083: values for the first select menu.  The text that coincides with the 
1.41      ng       1084: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1085: and text for the second menu are given in the hash pointed to by 
                   1086: $menu{$choice1}->{'select2'}.  
                   1087: 
1.112     bowersj2 1088:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1089:                        default => "B3",
                   1090:                        select2 => { 
                   1091:                            B1 => "Choice B1",
                   1092:                            B2 => "Choice B2",
                   1093:                            B3 => "Choice B3",
                   1094:                            B4 => "Choice B4"
1.609     raeburn  1095:                            },
                   1096:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1097:                    },
                   1098:                A2 => { text =>"Choice A2" ,
                   1099:                        default => "C2",
                   1100:                        select2 => { 
                   1101:                            C1 => "Choice C1",
                   1102:                            C2 => "Choice C2",
                   1103:                            C3 => "Choice C3"
1.609     raeburn  1104:                            },
                   1105:                        order => ['C2','C1','C3'],
1.112     bowersj2 1106:                    },
                   1107:                A3 => { text =>"Choice A3" ,
                   1108:                        default => "D6",
                   1109:                        select2 => { 
                   1110:                            D1 => "Choice D1",
                   1111:                            D2 => "Choice D2",
                   1112:                            D3 => "Choice D3",
                   1113:                            D4 => "Choice D4",
                   1114:                            D5 => "Choice D5",
                   1115:                            D6 => "Choice D6",
                   1116:                            D7 => "Choice D7"
1.609     raeburn  1117:                            },
                   1118:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1119:                    }
                   1120:                );
1.36      matthew  1121: 
                   1122: =cut
                   1123: 
                   1124: sub linked_select_forms {
                   1125:     my ($formname,
                   1126:         $middletext,
                   1127:         $firstdefault,
                   1128:         $firstselectname,
                   1129:         $secondselectname, 
1.609     raeburn  1130:         $hashref,
                   1131:         $menuorder,
1.1115    raeburn  1132:         $onchangefirst,
                   1133:         $onchangesecond
1.36      matthew  1134:         ) = @_;
                   1135:     my $second = "document.$formname.$secondselectname";
                   1136:     my $first = "document.$formname.$firstselectname";
                   1137:     # output the javascript to do the changing
                   1138:     my $result = '';
1.776     bisitz   1139:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1140:     $result.="// <![CDATA[\n";
1.36      matthew  1141:     $result.="var select2data = new Object();\n";
                   1142:     $" = '","';
                   1143:     my $debug = '';
                   1144:     foreach my $s1 (sort(keys(%$hashref))) {
                   1145:         $result.="select2data.d_$s1 = new Object();\n";        
                   1146:         $result.="select2data.d_$s1.def = new String('".
                   1147:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1148:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1149:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1150:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1151:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1152:         }
1.36      matthew  1153:         $result.="\"@s2values\");\n";
                   1154:         $result.="select2data.d_$s1.texts = new Array(";        
                   1155:         my @s2texts;
                   1156:         foreach my $value (@s2values) {
                   1157:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1158:         }
                   1159:         $result.="\"@s2texts\");\n";
                   1160:     }
                   1161:     $"=' ';
                   1162:     $result.= <<"END";
                   1163: 
                   1164: function select1_changed() {
                   1165:     // Determine new choice
                   1166:     var newvalue = "d_" + $first.value;
                   1167:     // update select2
                   1168:     var values     = select2data[newvalue].values;
                   1169:     var texts      = select2data[newvalue].texts;
                   1170:     var select2def = select2data[newvalue].def;
                   1171:     var i;
                   1172:     // out with the old
                   1173:     for (i = 0; i < $second.options.length; i++) {
                   1174:         $second.options[i] = null;
                   1175:     }
                   1176:     // in with the nuclear
                   1177:     for (i=0;i<values.length; i++) {
                   1178:         $second.options[i] = new Option(values[i]);
1.143     matthew  1179:         $second.options[i].value = values[i];
1.36      matthew  1180:         $second.options[i].text = texts[i];
                   1181:         if (values[i] == select2def) {
                   1182:             $second.options[i].selected = true;
                   1183:         }
                   1184:     }
                   1185: }
1.824     bisitz   1186: // ]]>
1.36      matthew  1187: </script>
                   1188: END
                   1189:     # output the initial values for the selection lists
1.1115    raeburn  1190:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1191:     my @order = sort(keys(%{$hashref}));
                   1192:     if (ref($menuorder) eq 'ARRAY') {
                   1193:         @order = @{$menuorder};
                   1194:     }
                   1195:     foreach my $value (@order) {
1.36      matthew  1196:         $result.="    <option value=\"$value\" ";
1.253     albertel 1197:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1198:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1199:     }
                   1200:     $result .= "</select>\n";
                   1201:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1202:     $result .= $middletext;
1.1115    raeburn  1203:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1204:     if ($onchangesecond) {
                   1205:         $result .= ' onchange="'.$onchangesecond.'"';
                   1206:     }
                   1207:     $result .= ">\n";
1.36      matthew  1208:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1209:     
                   1210:     my @secondorder = sort(keys(%select2));
                   1211:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1212:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1213:     }
                   1214:     foreach my $value (@secondorder) {
1.36      matthew  1215:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1216:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1217:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1218:     }
                   1219:     $result .= "</select>\n";
                   1220:     #    return $debug;
                   1221:     return $result;
                   1222: }   #  end of sub linked_select_forms {
                   1223: 
1.45      matthew  1224: =pod
1.44      bowersj2 1225: 
1.973     raeburn  1226: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1227: 
1.112     bowersj2 1228: Returns a string corresponding to an HTML link to the given help
                   1229: $topic, where $topic corresponds to the name of a .tex file in
                   1230: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1231: spaces. 
                   1232: 
                   1233: $text will optionally be linked to the same topic, allowing you to
                   1234: link text in addition to the graphic. If you do not want to link
                   1235: text, but wish to specify one of the later parameters, pass an
                   1236: empty string. 
                   1237: 
                   1238: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1239: the link will not open a new window. If false, the link will open
                   1240: a new window using Javascript. (Default is false.) 
                   1241: 
                   1242: $width and $height are optional numerical parameters that will
                   1243: override the width and height of the popped up window, which may
1.973     raeburn  1244: be useful for certain help topics with big pictures included.
                   1245: 
                   1246: $imgid is the id of the img tag used for the help icon. This may be
                   1247: used in a javascript call to switch the image src.  See 
                   1248: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1249: 
                   1250: =cut
                   1251: 
                   1252: sub help_open_topic {
1.973     raeburn  1253:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1254:     $text = "" if (not defined $text);
1.44      bowersj2 1255:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1256:     $width = 500 if (not defined $width);
1.44      bowersj2 1257:     $height = 400 if (not defined $height);
                   1258:     my $filename = $topic;
                   1259:     $filename =~ s/ /_/g;
                   1260: 
1.48      bowersj2 1261:     my $template = "";
                   1262:     my $link;
1.572     banghart 1263:     
1.159     www      1264:     $topic=~s/\W/\_/g;
1.44      bowersj2 1265: 
1.572     banghart 1266:     if (!$stayOnPage) {
1.1033    www      1267: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1268:     } elsif ($stayOnPage eq 'popup') {
                   1269:         $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 1270:     } else {
1.48      bowersj2 1271: 	$link = "/adm/help/${filename}.hlp";
                   1272:     }
                   1273: 
                   1274:     # Add the text
1.755     neumanie 1275:     if ($text ne "") {	
1.763     bisitz   1276: 	$template.='<span class="LC_help_open_topic">'
                   1277:                   .'<a target="_top" href="'.$link.'">'
                   1278:                   .$text.'</a>';
1.48      bowersj2 1279:     }
                   1280: 
1.763     bisitz   1281:     # (Always) Add the graphic
1.179     matthew  1282:     my $title = &mt('Online Help');
1.667     raeburn  1283:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1284:     if ($imgid ne '') {
                   1285:         $imgid = ' id="'.$imgid.'"';
                   1286:     }
1.763     bisitz   1287:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1288:               .'<img src="'.$helpicon.'" border="0"'
                   1289:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1290:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1291:               .' /></a>';
                   1292:     if ($text ne "") {	
                   1293:         $template.='</span>';
                   1294:     }
1.44      bowersj2 1295:     return $template;
                   1296: 
1.106     bowersj2 1297: }
                   1298: 
                   1299: # This is a quicky function for Latex cheatsheet editing, since it 
                   1300: # appears in at least four places
                   1301: sub helpLatexCheatsheet {
1.1037    www      1302:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1303:     my $out;
1.106     bowersj2 1304:     my $addOther = '';
1.732     raeburn  1305:     if ($topic) {
1.1037    www      1306: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1307:     }
                   1308:     $out = '<span>' # Start cheatsheet
                   1309: 	  .$addOther
                   1310:           .'<span>'
1.1037    www      1311: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1312: 	  .'</span> <span>'
1.1037    www      1313: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1314: 	  .'</span>';
1.732     raeburn  1315:     unless ($not_author) {
1.763     bisitz   1316:         $out .= ' <span>'
1.1037    www      1317: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763     bisitz   1318: 	       .'</span>';
1.732     raeburn  1319:     }
1.763     bisitz   1320:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1321:     return $out;
1.172     www      1322: }
                   1323: 
1.430     albertel 1324: sub general_help {
                   1325:     my $helptopic='Student_Intro';
                   1326:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1327: 	$helptopic='Authoring_Intro';
1.907     raeburn  1328:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1329: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1330:     } elsif ($env{'request.role'}=~/^dc/) {
                   1331:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1332:     }
                   1333:     return $helptopic;
                   1334: }
                   1335: 
                   1336: sub update_help_link {
                   1337:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1338:     my $origurl = $ENV{'REQUEST_URI'};
                   1339:     $origurl=~s|^/~|/priv/|;
                   1340:     my $timestamp = time;
                   1341:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1342:         $$datum = &escape($$datum);
                   1343:     }
                   1344: 
                   1345:     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";
                   1346:     my $output .= <<"ENDOUTPUT";
                   1347: <script type="text/javascript">
1.824     bisitz   1348: // <![CDATA[
1.430     albertel 1349: banner_link = '$banner_link';
1.824     bisitz   1350: // ]]>
1.430     albertel 1351: </script>
                   1352: ENDOUTPUT
                   1353:     return $output;
                   1354: }
                   1355: 
                   1356: # now just updates the help link and generates a blue icon
1.193     raeburn  1357: sub help_open_menu {
1.430     albertel 1358:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1359: 	= @_;    
1.949     droeschl 1360:     $stayOnPage = 1;
1.430     albertel 1361:     my $output;
                   1362:     if ($component_help) {
                   1363: 	if (!$text) {
                   1364: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1365: 				       $width,$height);
                   1366: 	} else {
                   1367: 	    my $help_text;
                   1368: 	    $help_text=&unescape($topic);
                   1369: 	    $output='<table><tr><td>'.
                   1370: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1371: 				 $width,$height).'</td></tr></table>';
                   1372: 	}
                   1373:     }
                   1374:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1375:     return $output.$banner_link;
                   1376: }
                   1377: 
                   1378: sub top_nav_help {
                   1379:     my ($text) = @_;
1.436     albertel 1380:     $text = &mt($text);
1.949     droeschl 1381:     my $stay_on_page = 1;
                   1382: 
1.572     banghart 1383:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1384: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1385:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1386: 
1.201     raeburn  1387:     my $title = &mt('Get help');
1.436     albertel 1388: 
                   1389:     return <<"END";
                   1390: $banner_link
                   1391:  <a href="$link" title="$title">$text</a>
                   1392: END
                   1393: }
                   1394: 
                   1395: sub help_menu_js {
                   1396:     my ($text) = @_;
1.949     droeschl 1397:     my $stayOnPage = 1;
1.436     albertel 1398:     my $width = 620;
                   1399:     my $height = 600;
1.430     albertel 1400:     my $helptopic=&general_help();
                   1401:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1402:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1403:     my $start_page =
                   1404:         &Apache::loncommon::start_page('Help Menu', undef,
                   1405: 				       {'frameset'    => 1,
                   1406: 					'js_ready'    => 1,
                   1407: 					'add_entries' => {
                   1408: 					    'border' => '0',
1.579     raeburn  1409: 					    'rows'   => "110,*",},});
1.331     albertel 1410:     my $end_page =
                   1411:         &Apache::loncommon::end_page({'frameset' => 1,
                   1412: 				      'js_ready' => 1,});
                   1413: 
1.436     albertel 1414:     my $template .= <<"ENDTEMPLATE";
                   1415: <script type="text/javascript">
1.877     bisitz   1416: // <![CDATA[
1.253     albertel 1417: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1418: var banner_link = '';
1.243     raeburn  1419: function helpMenu(target) {
                   1420:     var caller = this;
                   1421:     if (target == 'open') {
                   1422:         var newWindow = null;
                   1423:         try {
1.262     albertel 1424:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1425:         }
                   1426:         catch(error) {
                   1427:             writeHelp(caller);
                   1428:             return;
                   1429:         }
                   1430:         if (newWindow) {
                   1431:             caller = newWindow;
                   1432:         }
1.193     raeburn  1433:     }
1.243     raeburn  1434:     writeHelp(caller);
                   1435:     return;
                   1436: }
                   1437: function writeHelp(caller) {
1.1072    raeburn  1438:     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  1439:     caller.document.close()
                   1440:     caller.focus()
1.193     raeburn  1441: }
1.877     bisitz   1442: // END LON-CAPA Internal -->
1.253     albertel 1443: // ]]>
1.436     albertel 1444: </script>
1.193     raeburn  1445: ENDTEMPLATE
                   1446:     return $template;
                   1447: }
                   1448: 
1.172     www      1449: sub help_open_bug {
                   1450:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1451:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1452:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1453:     $text = "" if (not defined $text);
                   1454: 	$stayOnPage=1;
1.184     albertel 1455:     $width = 600 if (not defined $width);
                   1456:     $height = 600 if (not defined $height);
1.172     www      1457: 
                   1458:     $topic=~s/\W+/\+/g;
                   1459:     my $link='';
                   1460:     my $template='';
1.379     albertel 1461:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1462: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1463:     if (!$stayOnPage)
                   1464:     {
                   1465: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1466:     }
                   1467:     else
                   1468:     {
                   1469: 	$link = $url;
                   1470:     }
                   1471:     # Add the text
                   1472:     if ($text ne "")
                   1473:     {
                   1474: 	$template .= 
                   1475:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1476:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1477:     }
                   1478: 
                   1479:     # Add the graphic
1.179     matthew  1480:     my $title = &mt('Report a Bug');
1.215     albertel 1481:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1482:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1483:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1484: ENDTEMPLATE
                   1485:     if ($text ne '') { $template.='</td></tr></table>' };
                   1486:     return $template;
                   1487: 
                   1488: }
                   1489: 
                   1490: sub help_open_faq {
                   1491:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1492:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1493:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1494:     $text = "" if (not defined $text);
                   1495: 	$stayOnPage=1;
                   1496:     $width = 350 if (not defined $width);
                   1497:     $height = 400 if (not defined $height);
                   1498: 
                   1499:     $topic=~s/\W+/\+/g;
                   1500:     my $link='';
                   1501:     my $template='';
                   1502:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1503:     if (!$stayOnPage)
                   1504:     {
                   1505: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1506:     }
                   1507:     else
                   1508:     {
                   1509: 	$link = $url;
                   1510:     }
                   1511: 
                   1512:     # Add the text
                   1513:     if ($text ne "")
                   1514:     {
                   1515: 	$template .= 
1.173     www      1516:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1517:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1518:     }
                   1519: 
                   1520:     # Add the graphic
1.179     matthew  1521:     my $title = &mt('View the FAQ');
1.215     albertel 1522:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1523:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1524:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1525: ENDTEMPLATE
                   1526:     if ($text ne '') { $template.='</td></tr></table>' };
                   1527:     return $template;
                   1528: 
1.44      bowersj2 1529: }
1.37      matthew  1530: 
1.180     matthew  1531: ###############################################################
                   1532: ###############################################################
                   1533: 
1.45      matthew  1534: =pod
                   1535: 
1.648     raeburn  1536: =item * &change_content_javascript():
1.256     matthew  1537: 
                   1538: This and the next function allow you to create small sections of an
                   1539: otherwise static HTML page that you can update on the fly with
                   1540: Javascript, even in Netscape 4.
                   1541: 
                   1542: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1543: must be written to the HTML page once. It will prove the Javascript
                   1544: function "change(name, content)". Calling the change function with the
                   1545: name of the section 
                   1546: you want to update, matching the name passed to C<changable_area>, and
                   1547: the new content you want to put in there, will put the content into
                   1548: that area.
                   1549: 
                   1550: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1551: to contain room for the original contents. You need to "make space"
                   1552: for whatever changes you wish to make, and be B<sure> to check your
                   1553: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1554: it's adequate for updating a one-line status display, but little more.
                   1555: This script will set the space to 100% width, so you only need to
                   1556: worry about height in Netscape 4.
                   1557: 
                   1558: Modern browsers are much less limiting, and if you can commit to the
                   1559: user not using Netscape 4, this feature may be used freely with
                   1560: pretty much any HTML.
                   1561: 
                   1562: =cut
                   1563: 
                   1564: sub change_content_javascript {
                   1565:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1566:     if ($env{'browser.type'} eq 'netscape' &&
                   1567: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1568: 	return (<<NETSCAPE4);
                   1569: 	function change(name, content) {
                   1570: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1571: 	    doc.open();
                   1572: 	    doc.write(content);
                   1573: 	    doc.close();
                   1574: 	}
                   1575: NETSCAPE4
                   1576:     } else {
                   1577: 	# Otherwise, we need to use semi-standards-compliant code
                   1578: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1579: 	# is really scary, and every useful browser supports it
                   1580: 	return (<<DOMBASED);
                   1581: 	function change(name, content) {
                   1582: 	    element = document.getElementById(name);
                   1583: 	    element.innerHTML = content;
                   1584: 	}
                   1585: DOMBASED
                   1586:     }
                   1587: }
                   1588: 
                   1589: =pod
                   1590: 
1.648     raeburn  1591: =item * &changable_area($name,$origContent):
1.256     matthew  1592: 
                   1593: This provides a "changable area" that can be modified on the fly via
                   1594: the Javascript code provided in C<change_content_javascript>. $name is
                   1595: the name you will use to reference the area later; do not repeat the
                   1596: same name on a given HTML page more then once. $origContent is what
                   1597: the area will originally contain, which can be left blank.
                   1598: 
                   1599: =cut
                   1600: 
                   1601: sub changable_area {
                   1602:     my ($name, $origContent) = @_;
                   1603: 
1.258     albertel 1604:     if ($env{'browser.type'} eq 'netscape' &&
                   1605: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1606: 	# If this is netscape 4, we need to use the Layer tag
                   1607: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1608:     } else {
                   1609: 	return "<span id='$name'>$origContent</span>";
                   1610:     }
                   1611: }
                   1612: 
                   1613: =pod
                   1614: 
1.648     raeburn  1615: =item * &viewport_geometry_js 
1.590     raeburn  1616: 
                   1617: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1618: 
                   1619: =cut
                   1620: 
                   1621: 
                   1622: sub viewport_geometry_js { 
                   1623:     return <<"GEOMETRY";
                   1624: var Geometry = {};
                   1625: function init_geometry() {
                   1626:     if (Geometry.init) { return };
                   1627:     Geometry.init=1;
                   1628:     if (window.innerHeight) {
                   1629:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1630:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1631:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1632:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1633:     }
                   1634:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1635:         Geometry.getViewportHeight =
                   1636:             function() { return document.documentElement.clientHeight; };
                   1637:         Geometry.getViewportWidth =
                   1638:             function() { return document.documentElement.clientWidth; };
                   1639: 
                   1640:         Geometry.getHorizontalScroll =
                   1641:             function() { return document.documentElement.scrollLeft; };
                   1642:         Geometry.getVerticalScroll =
                   1643:             function() { return document.documentElement.scrollTop; };
                   1644:     }
                   1645:     else if (document.body.clientHeight) {
                   1646:         Geometry.getViewportHeight =
                   1647:             function() { return document.body.clientHeight; };
                   1648:         Geometry.getViewportWidth =
                   1649:             function() { return document.body.clientWidth; };
                   1650:         Geometry.getHorizontalScroll =
                   1651:             function() { return document.body.scrollLeft; };
                   1652:         Geometry.getVerticalScroll =
                   1653:             function() { return document.body.scrollTop; };
                   1654:     }
                   1655: }
                   1656: 
                   1657: GEOMETRY
                   1658: }
                   1659: 
                   1660: =pod
                   1661: 
1.648     raeburn  1662: =item * &viewport_size_js()
1.590     raeburn  1663: 
                   1664: 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. 
                   1665: 
                   1666: =cut
                   1667: 
                   1668: sub viewport_size_js {
                   1669:     my $geometry = &viewport_geometry_js();
                   1670:     return <<"DIMS";
                   1671: 
                   1672: $geometry
                   1673: 
                   1674: function getViewportDims(width,height) {
                   1675:     init_geometry();
                   1676:     width.value = Geometry.getViewportWidth();
                   1677:     height.value = Geometry.getViewportHeight();
                   1678:     return;
                   1679: }
                   1680: 
                   1681: DIMS
                   1682: }
                   1683: 
                   1684: =pod
                   1685: 
1.648     raeburn  1686: =item * &resize_textarea_js()
1.565     albertel 1687: 
                   1688: emits the needed javascript to resize a textarea to be as big as possible
                   1689: 
                   1690: creates a function resize_textrea that takes two IDs first should be
                   1691: the id of the element to resize, second should be the id of a div that
                   1692: surrounds everything that comes after the textarea, this routine needs
                   1693: to be attached to the <body> for the onload and onresize events.
                   1694: 
1.648     raeburn  1695: =back
1.565     albertel 1696: 
                   1697: =cut
                   1698: 
                   1699: sub resize_textarea_js {
1.590     raeburn  1700:     my $geometry = &viewport_geometry_js();
1.565     albertel 1701:     return <<"RESIZE";
                   1702:     <script type="text/javascript">
1.824     bisitz   1703: // <![CDATA[
1.590     raeburn  1704: $geometry
1.565     albertel 1705: 
1.588     albertel 1706: function getX(element) {
                   1707:     var x = 0;
                   1708:     while (element) {
                   1709: 	x += element.offsetLeft;
                   1710: 	element = element.offsetParent;
                   1711:     }
                   1712:     return x;
                   1713: }
                   1714: function getY(element) {
                   1715:     var y = 0;
                   1716:     while (element) {
                   1717: 	y += element.offsetTop;
                   1718: 	element = element.offsetParent;
                   1719:     }
                   1720:     return y;
                   1721: }
                   1722: 
                   1723: 
1.565     albertel 1724: function resize_textarea(textarea_id,bottom_id) {
                   1725:     init_geometry();
                   1726:     var textarea        = document.getElementById(textarea_id);
                   1727:     //alert(textarea);
                   1728: 
1.588     albertel 1729:     var textarea_top    = getY(textarea);
1.565     albertel 1730:     var textarea_height = textarea.offsetHeight;
                   1731:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1732:     var bottom_top      = getY(bottom);
1.565     albertel 1733:     var bottom_height   = bottom.offsetHeight;
                   1734:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1735:     var fudge           = 23;
1.565     albertel 1736:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1737:     if (new_height < 300) {
                   1738: 	new_height = 300;
                   1739:     }
                   1740:     textarea.style.height=new_height+'px';
                   1741: }
1.824     bisitz   1742: // ]]>
1.565     albertel 1743: </script>
                   1744: RESIZE
                   1745: 
                   1746: }
                   1747: 
                   1748: =pod
                   1749: 
1.256     matthew  1750: =head1 Excel and CSV file utility routines
                   1751: 
                   1752: =over 4
                   1753: 
                   1754: =cut
                   1755: 
                   1756: ###############################################################
                   1757: ###############################################################
                   1758: 
                   1759: =pod
                   1760: 
1.648     raeburn  1761: =item * &csv_translate($text) 
1.37      matthew  1762: 
1.185     www      1763: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1764: format.
                   1765: 
                   1766: =cut
                   1767: 
1.180     matthew  1768: ###############################################################
                   1769: ###############################################################
1.37      matthew  1770: sub csv_translate {
                   1771:     my $text = shift;
                   1772:     $text =~ s/\"/\"\"/g;
1.209     albertel 1773:     $text =~ s/\n/ /g;
1.37      matthew  1774:     return $text;
                   1775: }
1.180     matthew  1776: 
                   1777: ###############################################################
                   1778: ###############################################################
                   1779: 
                   1780: =pod
                   1781: 
1.648     raeburn  1782: =item * &define_excel_formats()
1.180     matthew  1783: 
                   1784: Define some commonly used Excel cell formats.
                   1785: 
                   1786: Currently supported formats:
                   1787: 
                   1788: =over 4
                   1789: 
                   1790: =item header
                   1791: 
                   1792: =item bold
                   1793: 
                   1794: =item h1
                   1795: 
                   1796: =item h2
                   1797: 
                   1798: =item h3
                   1799: 
1.256     matthew  1800: =item h4
                   1801: 
                   1802: =item i
                   1803: 
1.180     matthew  1804: =item date
                   1805: 
                   1806: =back
                   1807: 
                   1808: Inputs: $workbook
                   1809: 
                   1810: Returns: $format, a hash reference.
                   1811: 
1.1057    foxr     1812: 
1.180     matthew  1813: =cut
                   1814: 
                   1815: ###############################################################
                   1816: ###############################################################
                   1817: sub define_excel_formats {
                   1818:     my ($workbook) = @_;
                   1819:     my $format;
                   1820:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1821:                                                 bottom    => 1,
                   1822:                                                 align     => 'center');
                   1823:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1824:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1825:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1826:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1827:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1828:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1829:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1830:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1831:     return $format;
                   1832: }
                   1833: 
                   1834: ###############################################################
                   1835: ###############################################################
1.113     bowersj2 1836: 
                   1837: =pod
                   1838: 
1.648     raeburn  1839: =item * &create_workbook()
1.255     matthew  1840: 
                   1841: Create an Excel worksheet.  If it fails, output message on the
                   1842: request object and return undefs.
                   1843: 
                   1844: Inputs: Apache request object
                   1845: 
                   1846: Returns (undef) on failure, 
                   1847:     Excel worksheet object, scalar with filename, and formats 
                   1848:     from &Apache::loncommon::define_excel_formats on success
                   1849: 
                   1850: =cut
                   1851: 
                   1852: ###############################################################
                   1853: ###############################################################
                   1854: sub create_workbook {
                   1855:     my ($r) = @_;
                   1856:         #
                   1857:     # Create the excel spreadsheet
                   1858:     my $filename = '/prtspool/'.
1.258     albertel 1859:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1860:         time.'_'.rand(1000000000).'.xls';
                   1861:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1862:     if (! defined($workbook)) {
                   1863:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1864:         $r->print(
                   1865:             '<p class="LC_error">'
                   1866:            .&mt('Problems occurred in creating the new Excel file.')
                   1867:            .' '.&mt('This error has been logged.')
                   1868:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1869:            .'</p>'
                   1870:         );
1.255     matthew  1871:         return (undef);
                   1872:     }
                   1873:     #
1.1014    foxr     1874:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1875:     #
                   1876:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1877:     return ($workbook,$filename,$format);
                   1878: }
                   1879: 
                   1880: ###############################################################
                   1881: ###############################################################
                   1882: 
                   1883: =pod
                   1884: 
1.648     raeburn  1885: =item * &create_text_file()
1.113     bowersj2 1886: 
1.542     raeburn  1887: Create a file to write to and eventually make available to the user.
1.256     matthew  1888: If file creation fails, outputs an error message on the request object and 
                   1889: return undefs.
1.113     bowersj2 1890: 
1.256     matthew  1891: Inputs: Apache request object, and file suffix
1.113     bowersj2 1892: 
1.256     matthew  1893: Returns (undef) on failure, 
                   1894:     Filehandle and filename on success.
1.113     bowersj2 1895: 
                   1896: =cut
                   1897: 
1.256     matthew  1898: ###############################################################
                   1899: ###############################################################
                   1900: sub create_text_file {
                   1901:     my ($r,$suffix) = @_;
                   1902:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1903:     my $fh;
                   1904:     my $filename = '/prtspool/'.
1.258     albertel 1905:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1906:         time.'_'.rand(1000000000).'.'.$suffix;
                   1907:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1908:     if (! defined($fh)) {
                   1909:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1910:         $r->print(
                   1911:             '<p class="LC_error">'
                   1912:            .&mt('Problems occurred in creating the output file.')
                   1913:            .' '.&mt('This error has been logged.')
                   1914:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1915:            .'</p>'
                   1916:         );
1.113     bowersj2 1917:     }
1.256     matthew  1918:     return ($fh,$filename)
1.113     bowersj2 1919: }
                   1920: 
                   1921: 
1.256     matthew  1922: =pod 
1.113     bowersj2 1923: 
                   1924: =back
                   1925: 
                   1926: =cut
1.37      matthew  1927: 
                   1928: ###############################################################
1.33      matthew  1929: ##        Home server <option> list generating code          ##
                   1930: ###############################################################
1.35      matthew  1931: 
1.169     www      1932: # ------------------------------------------
                   1933: 
                   1934: sub domain_select {
                   1935:     my ($name,$value,$multiple)=@_;
                   1936:     my %domains=map { 
1.514     albertel 1937: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1938:     } &Apache::lonnet::all_domains();
1.169     www      1939:     if ($multiple) {
                   1940: 	$domains{''}=&mt('Any domain');
1.550     albertel 1941: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1942: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1943:     } else {
1.550     albertel 1944: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1945: 	return &select_form($name,$value,\%domains);
1.169     www      1946:     }
                   1947: }
                   1948: 
1.282     albertel 1949: #-------------------------------------------
                   1950: 
                   1951: =pod
                   1952: 
1.519     raeburn  1953: =head1 Routines for form select boxes
                   1954: 
                   1955: =over 4
                   1956: 
1.648     raeburn  1957: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1958: 
                   1959: Returns a string containing a <select> element int multiple mode
                   1960: 
                   1961: 
                   1962: Args:
                   1963:   $name - name of the <select> element
1.506     raeburn  1964:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1965:   $size - number of rows long the select element is
1.283     albertel 1966:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1967:           (shown text should already have been &mt())
1.506     raeburn  1968:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1969: 
1.282     albertel 1970: =cut
                   1971: 
                   1972: #-------------------------------------------
1.169     www      1973: sub multiple_select_form {
1.284     albertel 1974:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1975:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1976:     my $output='';
1.191     matthew  1977:     if (! defined($size)) {
                   1978:         $size = 4;
1.283     albertel 1979:         if (scalar(keys(%$hash))<4) {
                   1980:             $size = scalar(keys(%$hash));
1.191     matthew  1981:         }
                   1982:     }
1.734     bisitz   1983:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1984:     my @order;
1.506     raeburn  1985:     if (ref($order) eq 'ARRAY')  {
                   1986:         @order = @{$order};
                   1987:     } else {
                   1988:         @order = sort(keys(%$hash));
1.501     banghart 1989:     }
                   1990:     if (exists($$hash{'select_form_order'})) {
                   1991:         @order = @{$$hash{'select_form_order'}};
                   1992:     }
                   1993:         
1.284     albertel 1994:     foreach my $key (@order) {
1.356     albertel 1995:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1996:         $output.='selected="selected" ' if ($selected{$key});
                   1997:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1998:     }
                   1999:     $output.="</select>\n";
                   2000:     return $output;
                   2001: }
                   2002: 
1.88      www      2003: #-------------------------------------------
                   2004: 
                   2005: =pod
                   2006: 
1.970     raeburn  2007: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      2008: 
                   2009: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2010: allow a user to select options from a ref to a hash containing:
                   2011: option_name => displayed text. An optional $onchange can include
                   2012: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   2013: 
1.88      www      2014: See lonrights.pm for an example invocation and use.
                   2015: 
                   2016: =cut
                   2017: 
                   2018: #-------------------------------------------
                   2019: sub select_form {
1.970     raeburn  2020:     my ($def,$name,$hashref,$onchange) = @_;
                   2021:     return unless (ref($hashref) eq 'HASH');
                   2022:     if ($onchange) {
                   2023:         $onchange = ' onchange="'.$onchange.'"';
                   2024:     }
                   2025:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 2026:     my @keys;
1.970     raeburn  2027:     if (exists($hashref->{'select_form_order'})) {
                   2028: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2029:     } else {
1.970     raeburn  2030: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2031:     }
1.356     albertel 2032:     foreach my $key (@keys) {
                   2033:         $selectform.=
                   2034: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2035:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2036:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2037:     }
                   2038:     $selectform.="</select>";
                   2039:     return $selectform;
                   2040: }
                   2041: 
1.475     www      2042: # For display filters
                   2043: 
                   2044: sub display_filter {
1.1074    raeburn  2045:     my ($context) = @_;
1.475     www      2046:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2047:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2048:     my $phraseinput = 'hidden';
                   2049:     my $includeinput = 'hidden';
                   2050:     my ($checked,$includetypestext);
                   2051:     if ($env{'form.displayfilter'} eq 'containing') {
                   2052:         $phraseinput = 'text'; 
                   2053:         if ($context eq 'parmslog') {
                   2054:             $includeinput = 'checkbox';
                   2055:             if ($env{'form.includetypes'}) {
                   2056:                 $checked = ' checked="checked"';
                   2057:             }
                   2058:             $includetypestext = &mt('Include parameter types');
                   2059:         }
                   2060:     } else {
                   2061:         $includetypestext = '&nbsp;';
                   2062:     }
                   2063:     my ($additional,$secondid,$thirdid);
                   2064:     if ($context eq 'parmslog') {
                   2065:         $additional = 
                   2066:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2067:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2068:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2069:             '</label>';
                   2070:         $secondid = 'includetypes';
                   2071:         $thirdid = 'includetypestext';
                   2072:     }
                   2073:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2074:                                                     '$secondid','$thirdid')";
                   2075:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2076: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2077: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2078: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2079:            &mt('Filter: [_1]',
1.477     www      2080: 	   &select_form($env{'form.displayfilter'},
                   2081: 			'displayfilter',
1.970     raeburn  2082: 			{'currentfolder' => 'Current folder/page',
1.477     www      2083: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2084: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2085: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2086:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2087:                          '" />'.$additional;
                   2088: }
                   2089: 
                   2090: sub display_filter_js {
                   2091:     my $includetext = &mt('Include parameter types');
                   2092:     return <<"ENDJS";
                   2093:   
                   2094: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2095:     var firstType = 'hidden';
                   2096:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2097:         firstType = 'text';
                   2098:     }
                   2099:     firstObject = document.getElementById(firstid);
                   2100:     if (typeof(firstObject) == 'object') {
                   2101:         if (firstObject.type != firstType) {
                   2102:             changeInputType(firstObject,firstType);
                   2103:         }
                   2104:     }
                   2105:     if (context == 'parmslog') {
                   2106:         var secondType = 'hidden';
                   2107:         if (firstType == 'text') {
                   2108:             secondType = 'checkbox';
                   2109:         }
                   2110:         secondObject = document.getElementById(secondid);  
                   2111:         if (typeof(secondObject) == 'object') {
                   2112:             if (secondObject.type != secondType) {
                   2113:                 changeInputType(secondObject,secondType);
                   2114:             }
                   2115:         }
                   2116:         var textItem = document.getElementById(thirdid);
                   2117:         var currtext = textItem.innerHTML;
                   2118:         var newtext;
                   2119:         if (firstType == 'text') {
                   2120:             newtext = '$includetext';
                   2121:         } else {
                   2122:             newtext = '&nbsp;';
                   2123:         }
                   2124:         if (currtext != newtext) {
                   2125:             textItem.innerHTML = newtext;
                   2126:         }
                   2127:     }
                   2128:     return;
                   2129: }
                   2130: 
                   2131: function changeInputType(oldObject,newType) {
                   2132:     var newObject = document.createElement('input');
                   2133:     newObject.type = newType;
                   2134:     if (oldObject.size) {
                   2135:         newObject.size = oldObject.size;
                   2136:     }
                   2137:     if (oldObject.value) {
                   2138:         newObject.value = oldObject.value;
                   2139:     }
                   2140:     if (oldObject.name) {
                   2141:         newObject.name = oldObject.name;
                   2142:     }
                   2143:     if (oldObject.id) {
                   2144:         newObject.id = oldObject.id;
                   2145:     }
                   2146:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2147:     return;
                   2148: }
                   2149: 
                   2150: ENDJS
1.475     www      2151: }
                   2152: 
1.167     www      2153: sub gradeleveldescription {
                   2154:     my $gradelevel=shift;
                   2155:     my %gradelevels=(0 => 'Not specified',
                   2156: 		     1 => 'Grade 1',
                   2157: 		     2 => 'Grade 2',
                   2158: 		     3 => 'Grade 3',
                   2159: 		     4 => 'Grade 4',
                   2160: 		     5 => 'Grade 5',
                   2161: 		     6 => 'Grade 6',
                   2162: 		     7 => 'Grade 7',
                   2163: 		     8 => 'Grade 8',
                   2164: 		     9 => 'Grade 9',
                   2165: 		     10 => 'Grade 10',
                   2166: 		     11 => 'Grade 11',
                   2167: 		     12 => 'Grade 12',
                   2168: 		     13 => 'Grade 13',
                   2169: 		     14 => '100 Level',
                   2170: 		     15 => '200 Level',
                   2171: 		     16 => '300 Level',
                   2172: 		     17 => '400 Level',
                   2173: 		     18 => 'Graduate Level');
                   2174:     return &mt($gradelevels{$gradelevel});
                   2175: }
                   2176: 
1.163     www      2177: sub select_level_form {
                   2178:     my ($deflevel,$name)=@_;
                   2179:     unless ($deflevel) { $deflevel=0; }
1.167     www      2180:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2181:     for (my $i=0; $i<=18; $i++) {
                   2182:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2183:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2184:                 ">".&gradeleveldescription($i)."</option>\n";
                   2185:     }
                   2186:     $selectform.="</select>";
                   2187:     return $selectform;
1.163     www      2188: }
1.167     www      2189: 
1.35      matthew  2190: #-------------------------------------------
                   2191: 
1.45      matthew  2192: =pod
                   2193: 
1.1121    raeburn  2194: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2195: 
                   2196: Returns a string containing a <select name='$name' size='1'> form to 
                   2197: allow a user to select the domain to preform an operation in.  
                   2198: See loncreateuser.pm for an example invocation and use.
                   2199: 
1.90      www      2200: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2201: selected");
                   2202: 
1.743     raeburn  2203: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2204: 
1.910     raeburn  2205: 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.
                   2206: 
1.1121    raeburn  2207: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2208: 
                   2209: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563     raeburn  2210: 
1.35      matthew  2211: =cut
                   2212: 
                   2213: #-------------------------------------------
1.34      matthew  2214: sub select_dom_form {
1.1121    raeburn  2215:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2216:     if ($onchange) {
1.874     raeburn  2217:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2218:     }
1.1121    raeburn  2219:     my (@domains,%exclude);
1.910     raeburn  2220:     if (ref($incdoms) eq 'ARRAY') {
                   2221:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2222:     } else {
                   2223:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2224:     }
1.90      www      2225:     if ($includeempty) { @domains=('',@domains); }
1.1121    raeburn  2226:     if (ref($excdoms) eq 'ARRAY') {
                   2227:         map { $exclude{$_} = 1; } @{$excdoms}; 
                   2228:     }
1.743     raeburn  2229:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2230:     foreach my $dom (@domains) {
1.1121    raeburn  2231:         next if ($exclude{$dom});
1.356     albertel 2232:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2233:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2234:         if ($showdomdesc) {
                   2235:             if ($dom ne '') {
                   2236:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2237:                 if ($domdesc ne '') {
                   2238:                     $selectdomain .= ' ('.$domdesc.')';
                   2239:                 }
                   2240:             } 
                   2241:         }
                   2242:         $selectdomain .= "</option>\n";
1.34      matthew  2243:     }
                   2244:     $selectdomain.="</select>";
                   2245:     return $selectdomain;
                   2246: }
                   2247: 
1.35      matthew  2248: #-------------------------------------------
                   2249: 
1.45      matthew  2250: =pod
                   2251: 
1.648     raeburn  2252: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2253: 
1.586     raeburn  2254: input: 4 arguments (two required, two optional) - 
                   2255:     $domain - domain of new user
                   2256:     $name - name of form element
                   2257:     $default - Value of 'default' causes a default item to be first 
                   2258:                             option, and selected by default. 
                   2259:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2260:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2261: output: returns 2 items: 
1.586     raeburn  2262: (a) form element which contains either:
                   2263:    (i) <select name="$name">
                   2264:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2265:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2266:        </select>
                   2267:        form item if there are multiple library servers in $domain, or
                   2268:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2269:        if there is only one library server in $domain.
                   2270: 
                   2271: (b) number of library servers found.
                   2272: 
                   2273: See loncreateuser.pm for example of use.
1.35      matthew  2274: 
                   2275: =cut
                   2276: 
                   2277: #-------------------------------------------
1.586     raeburn  2278: sub home_server_form_item {
                   2279:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2280:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2281:     my $result;
                   2282:     my $numlib = keys(%servers);
                   2283:     if ($numlib > 1) {
                   2284:         $result .= '<select name="'.$name.'" />'."\n";
                   2285:         if ($default) {
1.804     bisitz   2286:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2287:                        '</option>'."\n";
                   2288:         }
                   2289:         foreach my $hostid (sort(keys(%servers))) {
                   2290:             $result.= '<option value="'.$hostid.'">'.
                   2291: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2292:         }
                   2293:         $result .= '</select>'."\n";
                   2294:     } elsif ($numlib == 1) {
                   2295:         my $hostid;
                   2296:         foreach my $item (keys(%servers)) {
                   2297:             $hostid = $item;
                   2298:         }
                   2299:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2300:                    $hostid.'" />';
                   2301:                    if (!$hide) {
                   2302:                        $result .= $hostid.' '.$servers{$hostid};
                   2303:                    }
                   2304:                    $result .= "\n";
                   2305:     } elsif ($default) {
                   2306:         $result .= '<input type="hidden" name="'.$name.
                   2307:                    '" value="default" />';
                   2308:                    if (!$hide) {
                   2309:                        $result .= &mt('default');
                   2310:                    }
                   2311:                    $result .= "\n";
1.33      matthew  2312:     }
1.586     raeburn  2313:     return ($result,$numlib);
1.33      matthew  2314: }
1.112     bowersj2 2315: 
                   2316: =pod
                   2317: 
1.534     albertel 2318: =back 
                   2319: 
1.112     bowersj2 2320: =cut
1.87      matthew  2321: 
                   2322: ###############################################################
1.112     bowersj2 2323: ##                  Decoding User Agent                      ##
1.87      matthew  2324: ###############################################################
                   2325: 
                   2326: =pod
                   2327: 
1.112     bowersj2 2328: =head1 Decoding the User Agent
                   2329: 
                   2330: =over 4
                   2331: 
                   2332: =item * &decode_user_agent()
1.87      matthew  2333: 
                   2334: Inputs: $r
                   2335: 
                   2336: Outputs:
                   2337: 
                   2338: =over 4
                   2339: 
1.112     bowersj2 2340: =item * $httpbrowser
1.87      matthew  2341: 
1.112     bowersj2 2342: =item * $clientbrowser
1.87      matthew  2343: 
1.112     bowersj2 2344: =item * $clientversion
1.87      matthew  2345: 
1.112     bowersj2 2346: =item * $clientmathml
1.87      matthew  2347: 
1.112     bowersj2 2348: =item * $clientunicode
1.87      matthew  2349: 
1.112     bowersj2 2350: =item * $clientos
1.87      matthew  2351: 
1.1137    raeburn  2352: =item * $clientmobile
                   2353: 
1.1141    raeburn  2354: =item * $clientinfo
                   2355: 
1.87      matthew  2356: =back
                   2357: 
1.157     matthew  2358: =back 
                   2359: 
1.87      matthew  2360: =cut
                   2361: 
                   2362: ###############################################################
                   2363: ###############################################################
                   2364: sub decode_user_agent {
1.247     albertel 2365:     my ($r)=@_;
1.87      matthew  2366:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2367:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2368:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2369:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2370:     my $clientbrowser='unknown';
                   2371:     my $clientversion='0';
                   2372:     my $clientmathml='';
                   2373:     my $clientunicode='0';
1.1137    raeburn  2374:     my $clientmobile=0;
1.87      matthew  2375:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2376:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2377: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2378: 	    $clientbrowser=$bname;
                   2379:             $httpbrowser=~/$vreg/i;
                   2380: 	    $clientversion=$1;
                   2381:             $clientmathml=($clientversion>=$minv);
                   2382:             $clientunicode=($clientversion>=$univ);
                   2383: 	}
                   2384:     }
                   2385:     my $clientos='unknown';
1.1141    raeburn  2386:     my $clientinfo;
1.87      matthew  2387:     if (($httpbrowser=~/linux/i) ||
                   2388:         ($httpbrowser=~/unix/i) ||
                   2389:         ($httpbrowser=~/ux/i) ||
                   2390:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2391:     if (($httpbrowser=~/vax/i) ||
                   2392:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2393:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2394:     if (($httpbrowser=~/mac/i) ||
                   2395:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2396:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2397:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137    raeburn  2398:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2399:         $clientmobile=lc($1);
                   2400:     }
1.1141    raeburn  2401:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2402:         $clientinfo = 'firefox-'.$1;
                   2403:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2404:         $clientinfo = 'chromeframe-'.$1;
                   2405:     }
1.87      matthew  2406:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1141    raeburn  2407:             $clientunicode,$clientos,$clientmobile,$clientinfo);
1.87      matthew  2408: }
                   2409: 
1.32      matthew  2410: ###############################################################
                   2411: ##    Authentication changing form generation subroutines    ##
                   2412: ###############################################################
                   2413: ##
                   2414: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2415: ## hash, and have reasonable default values.
                   2416: ##
                   2417: ##    formname = the name given in the <form> tag.
1.35      matthew  2418: #-------------------------------------------
                   2419: 
1.45      matthew  2420: =pod
                   2421: 
1.112     bowersj2 2422: =head1 Authentication Routines
                   2423: 
                   2424: =over 4
                   2425: 
1.648     raeburn  2426: =item * &authform_xxxxxx()
1.35      matthew  2427: 
                   2428: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2429: handle some of the conveniences required for authentication forms.  
                   2430: This is not an optimal method, but it works.  
                   2431: 
                   2432: =over 4
                   2433: 
1.112     bowersj2 2434: =item * authform_header
1.35      matthew  2435: 
1.112     bowersj2 2436: =item * authform_authorwarning
1.35      matthew  2437: 
1.112     bowersj2 2438: =item * authform_nochange
1.35      matthew  2439: 
1.112     bowersj2 2440: =item * authform_kerberos
1.35      matthew  2441: 
1.112     bowersj2 2442: =item * authform_internal
1.35      matthew  2443: 
1.112     bowersj2 2444: =item * authform_filesystem
1.35      matthew  2445: 
                   2446: =back
                   2447: 
1.648     raeburn  2448: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2449: 
1.35      matthew  2450: =cut
                   2451: 
                   2452: #-------------------------------------------
1.32      matthew  2453: sub authform_header{  
                   2454:     my %in = (
                   2455:         formname => 'cu',
1.80      albertel 2456:         kerb_def_dom => '',
1.32      matthew  2457:         @_,
                   2458:     );
                   2459:     $in{'formname'} = 'document.' . $in{'formname'};
                   2460:     my $result='';
1.80      albertel 2461: 
                   2462: #---------------------------------------------- Code for upper case translation
                   2463:     my $Javascript_toUpperCase;
                   2464:     unless ($in{kerb_def_dom}) {
                   2465:         $Javascript_toUpperCase =<<"END";
                   2466:         switch (choice) {
                   2467:            case 'krb': currentform.elements[choicearg].value =
                   2468:                currentform.elements[choicearg].value.toUpperCase();
                   2469:                break;
                   2470:            default:
                   2471:         }
                   2472: END
                   2473:     } else {
                   2474:         $Javascript_toUpperCase = "";
                   2475:     }
                   2476: 
1.165     raeburn  2477:     my $radioval = "'nochange'";
1.591     raeburn  2478:     if (defined($in{'curr_authtype'})) {
                   2479:         if ($in{'curr_authtype'} ne '') {
                   2480:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2481:         }
1.174     matthew  2482:     }
1.165     raeburn  2483:     my $argfield = 'null';
1.591     raeburn  2484:     if (defined($in{'mode'})) {
1.165     raeburn  2485:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2486:             if (defined($in{'curr_autharg'})) {
                   2487:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2488:                     $argfield = "'$in{'curr_autharg'}'";
                   2489:                 }
                   2490:             }
                   2491:         }
                   2492:     }
                   2493: 
1.32      matthew  2494:     $result.=<<"END";
                   2495: var current = new Object();
1.165     raeburn  2496: current.radiovalue = $radioval;
                   2497: current.argfield = $argfield;
1.32      matthew  2498: 
                   2499: function changed_radio(choice,currentform) {
                   2500:     var choicearg = choice + 'arg';
                   2501:     // If a radio button in changed, we need to change the argfield
                   2502:     if (current.radiovalue != choice) {
                   2503:         current.radiovalue = choice;
                   2504:         if (current.argfield != null) {
                   2505:             currentform.elements[current.argfield].value = '';
                   2506:         }
                   2507:         if (choice == 'nochange') {
                   2508:             current.argfield = null;
                   2509:         } else {
                   2510:             current.argfield = choicearg;
                   2511:             switch(choice) {
                   2512:                 case 'krb': 
                   2513:                     currentform.elements[current.argfield].value = 
                   2514:                         "$in{'kerb_def_dom'}";
                   2515:                 break;
                   2516:               default:
                   2517:                 break;
                   2518:             }
                   2519:         }
                   2520:     }
                   2521:     return;
                   2522: }
1.22      www      2523: 
1.32      matthew  2524: function changed_text(choice,currentform) {
                   2525:     var choicearg = choice + 'arg';
                   2526:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2527:         $Javascript_toUpperCase
1.32      matthew  2528:         // clear old field
                   2529:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2530:             currentform.elements[current.argfield].value = '';
                   2531:         }
                   2532:         current.argfield = choicearg;
                   2533:     }
                   2534:     set_auth_radio_buttons(choice,currentform);
                   2535:     return;
1.20      www      2536: }
1.32      matthew  2537: 
                   2538: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2539:     var numauthchoices = currentform.login.length;
                   2540:     if (typeof numauthchoices  == "undefined") {
                   2541:         return;
                   2542:     } 
1.32      matthew  2543:     var i=0;
1.986     raeburn  2544:     while (i < numauthchoices) {
1.32      matthew  2545:         if (currentform.login[i].value == newvalue) { break; }
                   2546:         i++;
                   2547:     }
1.986     raeburn  2548:     if (i == numauthchoices) {
1.32      matthew  2549:         return;
                   2550:     }
                   2551:     current.radiovalue = newvalue;
                   2552:     currentform.login[i].checked = true;
                   2553:     return;
                   2554: }
                   2555: END
                   2556:     return $result;
                   2557: }
                   2558: 
1.1106    raeburn  2559: sub authform_authorwarning {
1.32      matthew  2560:     my $result='';
1.144     matthew  2561:     $result='<i>'.
                   2562:         &mt('As a general rule, only authors or co-authors should be '.
                   2563:             'filesystem authenticated '.
                   2564:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2565:     return $result;
                   2566: }
                   2567: 
1.1106    raeburn  2568: sub authform_nochange {
1.32      matthew  2569:     my %in = (
                   2570:               formname => 'document.cu',
                   2571:               kerb_def_dom => 'MSU.EDU',
                   2572:               @_,
                   2573:           );
1.1106    raeburn  2574:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586     raeburn  2575:     my $result;
1.1104    raeburn  2576:     if (!$authnum) {
1.1105    raeburn  2577:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2578:     } else {
                   2579:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2580:                   '<input type="radio" name="login" value="nochange" '.
                   2581:                   'checked="checked" onclick="'.
1.281     albertel 2582:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2583: 	    '</label>';
1.586     raeburn  2584:     }
1.32      matthew  2585:     return $result;
                   2586: }
                   2587: 
1.591     raeburn  2588: sub authform_kerberos {
1.32      matthew  2589:     my %in = (
                   2590:               formname => 'document.cu',
                   2591:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2592:               kerb_def_auth => 'krb4',
1.32      matthew  2593:               @_,
                   2594:               );
1.586     raeburn  2595:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2596:         $autharg,$jscall);
1.1106    raeburn  2597:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2598:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2599:        $check5 = ' checked="checked"';
1.80      albertel 2600:     } else {
1.772     bisitz   2601:        $check4 = ' checked="checked"';
1.80      albertel 2602:     }
1.165     raeburn  2603:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2604:     if (defined($in{'curr_authtype'})) {
                   2605:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2606:             $krbcheck = ' checked="checked"';
1.623     raeburn  2607:             if (defined($in{'mode'})) {
                   2608:                 if ($in{'mode'} eq 'modifyuser') {
                   2609:                     $krbcheck = '';
                   2610:                 }
                   2611:             }
1.591     raeburn  2612:             if (defined($in{'curr_kerb_ver'})) {
                   2613:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2614:                     $check5 = ' checked="checked"';
1.591     raeburn  2615:                     $check4 = '';
                   2616:                 } else {
1.772     bisitz   2617:                     $check4 = ' checked="checked"';
1.591     raeburn  2618:                     $check5 = '';
                   2619:                 }
1.586     raeburn  2620:             }
1.591     raeburn  2621:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2622:                 $krbarg = $in{'curr_autharg'};
                   2623:             }
1.586     raeburn  2624:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2625:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2626:                     $result = 
                   2627:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2628:         $in{'curr_autharg'},$krbver);
                   2629:                 } else {
                   2630:                     $result =
                   2631:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2632:                 }
                   2633:                 return $result; 
                   2634:             }
                   2635:         }
                   2636:     } else {
                   2637:         if ($authnum == 1) {
1.784     bisitz   2638:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2639:         }
                   2640:     }
1.586     raeburn  2641:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2642:         return;
1.587     raeburn  2643:     } elsif ($authtype eq '') {
1.591     raeburn  2644:         if (defined($in{'mode'})) {
1.587     raeburn  2645:             if ($in{'mode'} eq 'modifycourse') {
                   2646:                 if ($authnum == 1) {
1.1104    raeburn  2647:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2648:                 }
                   2649:             }
                   2650:         }
1.586     raeburn  2651:     }
                   2652:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2653:     if ($authtype eq '') {
                   2654:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2655:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2656:                     $krbcheck.' />';
                   2657:     }
                   2658:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106    raeburn  2659:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2660:          $in{'curr_authtype'} eq 'krb5') ||
1.1106    raeburn  2661:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2662:          $in{'curr_authtype'} eq 'krb4')) {
                   2663:         $result .= &mt
1.144     matthew  2664:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2665:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2666:          '<label>'.$authtype,
1.281     albertel 2667:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2668:              'value="'.$krbarg.'" '.
1.144     matthew  2669:              'onchange="'.$jscall.'" />',
1.281     albertel 2670:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2671:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2672: 	 '</label>');
1.586     raeburn  2673:     } elsif ($can_assign{'krb4'}) {
                   2674:         $result .= &mt
                   2675:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2676:          '[_3] Version 4 [_4]',
                   2677:          '<label>'.$authtype,
                   2678:          '</label><input type="text" size="10" name="krbarg" '.
                   2679:              'value="'.$krbarg.'" '.
                   2680:              'onchange="'.$jscall.'" />',
                   2681:          '<label><input type="hidden" name="krbver" value="4" />',
                   2682:          '</label>');
                   2683:     } elsif ($can_assign{'krb5'}) {
                   2684:         $result .= &mt
                   2685:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2686:          '[_3] Version 5 [_4]',
                   2687:          '<label>'.$authtype,
                   2688:          '</label><input type="text" size="10" name="krbarg" '.
                   2689:              'value="'.$krbarg.'" '.
                   2690:              'onchange="'.$jscall.'" />',
                   2691:          '<label><input type="hidden" name="krbver" value="5" />',
                   2692:          '</label>');
                   2693:     }
1.32      matthew  2694:     return $result;
                   2695: }
                   2696: 
1.1106    raeburn  2697: sub authform_internal {
1.586     raeburn  2698:     my %in = (
1.32      matthew  2699:                 formname => 'document.cu',
                   2700:                 kerb_def_dom => 'MSU.EDU',
                   2701:                 @_,
                   2702:                 );
1.586     raeburn  2703:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2704:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2705:     if (defined($in{'curr_authtype'})) {
                   2706:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2707:             if ($can_assign{'int'}) {
1.772     bisitz   2708:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2709:                 if (defined($in{'mode'})) {
                   2710:                     if ($in{'mode'} eq 'modifyuser') {
                   2711:                         $intcheck = '';
                   2712:                     }
                   2713:                 }
1.591     raeburn  2714:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2715:                     $intarg = $in{'curr_autharg'};
                   2716:                 }
                   2717:             } else {
                   2718:                 $result = &mt('Currently internally authenticated.');
                   2719:                 return $result;
1.165     raeburn  2720:             }
                   2721:         }
1.586     raeburn  2722:     } else {
                   2723:         if ($authnum == 1) {
1.784     bisitz   2724:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2725:         }
                   2726:     }
                   2727:     if (!$can_assign{'int'}) {
                   2728:         return;
1.587     raeburn  2729:     } elsif ($authtype eq '') {
1.591     raeburn  2730:         if (defined($in{'mode'})) {
1.587     raeburn  2731:             if ($in{'mode'} eq 'modifycourse') {
                   2732:                 if ($authnum == 1) {
1.1104    raeburn  2733:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2734:                 }
                   2735:             }
                   2736:         }
1.165     raeburn  2737:     }
1.586     raeburn  2738:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2739:     if ($authtype eq '') {
                   2740:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2741:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2742:     }
1.605     bisitz   2743:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2744:                $intarg.'" onchange="'.$jscall.'" />';
                   2745:     $result = &mt
1.144     matthew  2746:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2747:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2748:     $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  2749:     return $result;
                   2750: }
                   2751: 
1.1104    raeburn  2752: sub authform_local {
1.32      matthew  2753:     my %in = (
                   2754:               formname => 'document.cu',
                   2755:               kerb_def_dom => 'MSU.EDU',
                   2756:               @_,
                   2757:               );
1.586     raeburn  2758:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2759:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2760:     if (defined($in{'curr_authtype'})) {
                   2761:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2762:             if ($can_assign{'loc'}) {
1.772     bisitz   2763:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2764:                 if (defined($in{'mode'})) {
                   2765:                     if ($in{'mode'} eq 'modifyuser') {
                   2766:                         $loccheck = '';
                   2767:                     }
                   2768:                 }
1.591     raeburn  2769:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2770:                     $locarg = $in{'curr_autharg'};
                   2771:                 }
                   2772:             } else {
                   2773:                 $result = &mt('Currently using local (institutional) authentication.');
                   2774:                 return $result;
1.165     raeburn  2775:             }
                   2776:         }
1.586     raeburn  2777:     } else {
                   2778:         if ($authnum == 1) {
1.784     bisitz   2779:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2780:         }
                   2781:     }
                   2782:     if (!$can_assign{'loc'}) {
                   2783:         return;
1.587     raeburn  2784:     } elsif ($authtype eq '') {
1.591     raeburn  2785:         if (defined($in{'mode'})) {
1.587     raeburn  2786:             if ($in{'mode'} eq 'modifycourse') {
                   2787:                 if ($authnum == 1) {
1.1104    raeburn  2788:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2789:                 }
                   2790:             }
                   2791:         }
1.165     raeburn  2792:     }
1.586     raeburn  2793:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2794:     if ($authtype eq '') {
                   2795:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2796:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2797:                     $jscall.'" />';
                   2798:     }
                   2799:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2800:                $locarg.'" onchange="'.$jscall.'" />';
                   2801:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2802:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2803:     return $result;
                   2804: }
                   2805: 
1.1106    raeburn  2806: sub authform_filesystem {
1.32      matthew  2807:     my %in = (
                   2808:               formname => 'document.cu',
                   2809:               kerb_def_dom => 'MSU.EDU',
                   2810:               @_,
                   2811:               );
1.586     raeburn  2812:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2813:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2814:     if (defined($in{'curr_authtype'})) {
                   2815:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2816:             if ($can_assign{'fsys'}) {
1.772     bisitz   2817:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2818:                 if (defined($in{'mode'})) {
                   2819:                     if ($in{'mode'} eq 'modifyuser') {
                   2820:                         $fsyscheck = '';
                   2821:                     }
                   2822:                 }
1.586     raeburn  2823:             } else {
                   2824:                 $result = &mt('Currently Filesystem Authenticated.');
                   2825:                 return $result;
                   2826:             }           
                   2827:         }
                   2828:     } else {
                   2829:         if ($authnum == 1) {
1.784     bisitz   2830:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2831:         }
                   2832:     }
                   2833:     if (!$can_assign{'fsys'}) {
                   2834:         return;
1.587     raeburn  2835:     } elsif ($authtype eq '') {
1.591     raeburn  2836:         if (defined($in{'mode'})) {
1.587     raeburn  2837:             if ($in{'mode'} eq 'modifycourse') {
                   2838:                 if ($authnum == 1) {
1.1104    raeburn  2839:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2840:                 }
                   2841:             }
                   2842:         }
1.586     raeburn  2843:     }
                   2844:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2845:     if ($authtype eq '') {
                   2846:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2847:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2848:                     $jscall.'" />';
                   2849:     }
                   2850:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2851:                ' onchange="'.$jscall.'" />';
                   2852:     $result = &mt
1.144     matthew  2853:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2854:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2855:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2856:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2857:                   'onchange="'.$jscall.'" />');
1.32      matthew  2858:     return $result;
                   2859: }
                   2860: 
1.586     raeburn  2861: sub get_assignable_auth {
                   2862:     my ($dom) = @_;
                   2863:     if ($dom eq '') {
                   2864:         $dom = $env{'request.role.domain'};
                   2865:     }
                   2866:     my %can_assign = (
                   2867:                           krb4 => 1,
                   2868:                           krb5 => 1,
                   2869:                           int  => 1,
                   2870:                           loc  => 1,
                   2871:                      );
                   2872:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2873:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2874:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2875:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2876:             my $context;
                   2877:             if ($env{'request.role'} =~ /^au/) {
                   2878:                 $context = 'author';
                   2879:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2880:                 $context = 'domain';
                   2881:             } elsif ($env{'request.course.id'}) {
                   2882:                 $context = 'course';
                   2883:             }
                   2884:             if ($context) {
                   2885:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2886:                    %can_assign = %{$authhash->{$context}}; 
                   2887:                 }
                   2888:             }
                   2889:         }
                   2890:     }
                   2891:     my $authnum = 0;
                   2892:     foreach my $key (keys(%can_assign)) {
                   2893:         if ($can_assign{$key}) {
                   2894:             $authnum ++;
                   2895:         }
                   2896:     }
                   2897:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2898:         $authnum --;
                   2899:     }
                   2900:     return ($authnum,%can_assign);
                   2901: }
                   2902: 
1.80      albertel 2903: ###############################################################
                   2904: ##    Get Kerberos Defaults for Domain                 ##
                   2905: ###############################################################
                   2906: ##
                   2907: ## Returns default kerberos version and an associated argument
                   2908: ## as listed in file domain.tab. If not listed, provides
                   2909: ## appropriate default domain and kerberos version.
                   2910: ##
                   2911: #-------------------------------------------
                   2912: 
                   2913: =pod
                   2914: 
1.648     raeburn  2915: =item * &get_kerberos_defaults()
1.80      albertel 2916: 
                   2917: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2918: version and domain. If not found, it defaults to version 4 and the 
                   2919: domain of the server.
1.80      albertel 2920: 
1.648     raeburn  2921: =over 4
                   2922: 
1.80      albertel 2923: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2924: 
1.648     raeburn  2925: =back
                   2926: 
                   2927: =back
                   2928: 
1.80      albertel 2929: =cut
                   2930: 
                   2931: #-------------------------------------------
                   2932: sub get_kerberos_defaults {
                   2933:     my $domain=shift;
1.641     raeburn  2934:     my ($krbdef,$krbdefdom);
                   2935:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2936:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2937:         $krbdef = $domdefaults{'auth_def'};
                   2938:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2939:     } else {
1.80      albertel 2940:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2941:         my $krbdefdom=$1;
                   2942:         $krbdefdom=~tr/a-z/A-Z/;
                   2943:         $krbdef = "krb4";
                   2944:     }
                   2945:     return ($krbdef,$krbdefdom);
                   2946: }
1.112     bowersj2 2947: 
1.32      matthew  2948: 
1.46      matthew  2949: ###############################################################
                   2950: ##                Thesaurus Functions                        ##
                   2951: ###############################################################
1.20      www      2952: 
1.46      matthew  2953: =pod
1.20      www      2954: 
1.112     bowersj2 2955: =head1 Thesaurus Functions
                   2956: 
                   2957: =over 4
                   2958: 
1.648     raeburn  2959: =item * &initialize_keywords()
1.46      matthew  2960: 
                   2961: Initializes the package variable %Keywords if it is empty.  Uses the
                   2962: package variable $thesaurus_db_file.
                   2963: 
                   2964: =cut
                   2965: 
                   2966: ###################################################
                   2967: 
                   2968: sub initialize_keywords {
                   2969:     return 1 if (scalar keys(%Keywords));
                   2970:     # If we are here, %Keywords is empty, so fill it up
                   2971:     #   Make sure the file we need exists...
                   2972:     if (! -e $thesaurus_db_file) {
                   2973:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2974:                                  " failed because it does not exist");
                   2975:         return 0;
                   2976:     }
                   2977:     #   Set up the hash as a database
                   2978:     my %thesaurus_db;
                   2979:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2980:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2981:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2982:                                  $thesaurus_db_file);
                   2983:         return 0;
                   2984:     } 
                   2985:     #  Get the average number of appearances of a word.
                   2986:     my $avecount = $thesaurus_db{'average.count'};
                   2987:     #  Put keywords (those that appear > average) into %Keywords
                   2988:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2989:         my ($count,undef) = split /:/,$data;
                   2990:         $Keywords{$word}++ if ($count > $avecount);
                   2991:     }
                   2992:     untie %thesaurus_db;
                   2993:     # Remove special values from %Keywords.
1.356     albertel 2994:     foreach my $value ('total.count','average.count') {
                   2995:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2996:   }
1.46      matthew  2997:     return 1;
                   2998: }
                   2999: 
                   3000: ###################################################
                   3001: 
                   3002: =pod
                   3003: 
1.648     raeburn  3004: =item * &keyword($word)
1.46      matthew  3005: 
                   3006: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3007: than the average number of times in the thesaurus database.  Calls 
                   3008: &initialize_keywords
                   3009: 
                   3010: =cut
                   3011: 
                   3012: ###################################################
1.20      www      3013: 
                   3014: sub keyword {
1.46      matthew  3015:     return if (!&initialize_keywords());
                   3016:     my $word=lc(shift());
                   3017:     $word=~s/\W//g;
                   3018:     return exists($Keywords{$word});
1.20      www      3019: }
1.46      matthew  3020: 
                   3021: ###############################################################
                   3022: 
                   3023: =pod 
1.20      www      3024: 
1.648     raeburn  3025: =item * &get_related_words()
1.46      matthew  3026: 
1.160     matthew  3027: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3028: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3029: will be returned.  The order of the words returned is determined by the
                   3030: database which holds them.
                   3031: 
                   3032: Uses global $thesaurus_db_file.
                   3033: 
1.1057    foxr     3034: 
1.46      matthew  3035: =cut
                   3036: 
                   3037: ###############################################################
                   3038: sub get_related_words {
                   3039:     my $keyword = shift;
                   3040:     my %thesaurus_db;
                   3041:     if (! -e $thesaurus_db_file) {
                   3042:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3043:                                  "failed because the file does not exist");
                   3044:         return ();
                   3045:     }
                   3046:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3047:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3048:         return ();
                   3049:     } 
                   3050:     my @Words=();
1.429     www      3051:     my $count=0;
1.46      matthew  3052:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3053: 	# The first element is the number of times
                   3054: 	# the word appears.  We do not need it now.
1.429     www      3055: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3056: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3057: 	my $threshold=$mostfrequentcount/10;
                   3058:         foreach my $possibleword (@RelatedWords) {
                   3059:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3060:             if ($wordcount>$threshold) {
                   3061: 		push(@Words,$word);
                   3062:                 $count++;
                   3063:                 if ($count>10) { last; }
                   3064: 	    }
1.20      www      3065:         }
                   3066:     }
1.46      matthew  3067:     untie %thesaurus_db;
                   3068:     return @Words;
1.14      harris41 3069: }
1.1090    foxr     3070: ###############################################################
                   3071: #
                   3072: #  Spell checking
                   3073: #
                   3074: 
                   3075: =pod
                   3076: 
1.1142    raeburn  3077: =back
                   3078: 
1.1090    foxr     3079: =head1 Spell checking
                   3080: 
                   3081: =over 4
                   3082: 
                   3083: =item * &check_spelling($wordlist $language)
                   3084: 
                   3085: Takes a string containing words and feeds it to an external
                   3086: spellcheck program via a pipeline. Returns a string containing
                   3087: them mis-spelled words.
                   3088: 
                   3089: Parameters:
                   3090: 
                   3091: =over 4
                   3092: 
                   3093: =item - $wordlist
                   3094: 
                   3095: String that will be fed into the spellcheck program.
                   3096: 
                   3097: =item - $language
                   3098: 
                   3099: Language string that specifies the language for which the spell
                   3100: check will be performed.
                   3101: 
                   3102: =back
                   3103: 
                   3104: =back
                   3105: 
                   3106: Note: This sub assumes that aspell is installed.
                   3107: 
                   3108: 
                   3109: =cut
                   3110: 
1.46      matthew  3111: 
1.1090    foxr     3112: sub check_spelling {
                   3113:     my ($wordlist, $language) = @_;
1.1091    foxr     3114:     my @misspellings;
                   3115:     
                   3116:     # Generate the speller and set the langauge.
                   3117:     # if explicitly selected:
1.1090    foxr     3118: 
1.1091    foxr     3119:     my $speller = Text::Aspell->new;
1.1090    foxr     3120:     if ($language) {
1.1091    foxr     3121: 	$speller->set_option('lang', $language);
1.1090    foxr     3122:     }
                   3123: 
1.1091    foxr     3124:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     3125: 
1.1091    foxr     3126:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     3127: 
1.1091    foxr     3128:     foreach my $word (@words) {
                   3129: 	if(! $speller->check($word)) {
                   3130: 	    push(@misspellings, $word);
1.1090    foxr     3131: 	}
                   3132:     }
1.1091    foxr     3133:     return join(' ', @misspellings);
                   3134:     
1.1090    foxr     3135: }
                   3136: 
1.61      www      3137: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3138: =pod
                   3139: 
1.112     bowersj2 3140: =head1 User Name Functions
                   3141: 
                   3142: =over 4
                   3143: 
1.648     raeburn  3144: =item * &plainname($uname,$udom,$first)
1.81      albertel 3145: 
1.112     bowersj2 3146: Takes a users logon name and returns it as a string in
1.226     albertel 3147: "first middle last generation" form 
                   3148: if $first is set to 'lastname' then it returns it as
                   3149: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3150: 
                   3151: =cut
1.61      www      3152: 
1.295     www      3153: 
1.81      albertel 3154: ###############################################################
1.61      www      3155: sub plainname {
1.226     albertel 3156:     my ($uname,$udom,$first)=@_;
1.537     albertel 3157:     return if (!defined($uname) || !defined($udom));
1.295     www      3158:     my %names=&getnames($uname,$udom);
1.226     albertel 3159:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3160: 					  $names{'middlename'},
                   3161: 					  $names{'lastname'},
                   3162: 					  $names{'generation'},$first);
                   3163:     $name=~s/^\s+//;
1.62      www      3164:     $name=~s/\s+$//;
                   3165:     $name=~s/\s+/ /g;
1.353     albertel 3166:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3167:     return $name;
1.61      www      3168: }
1.66      www      3169: 
                   3170: # -------------------------------------------------------------------- Nickname
1.81      albertel 3171: =pod
                   3172: 
1.648     raeburn  3173: =item * &nickname($uname,$udom)
1.81      albertel 3174: 
                   3175: Gets a users name and returns it as a string as
                   3176: 
                   3177: "&quot;nickname&quot;"
1.66      www      3178: 
1.81      albertel 3179: if the user has a nickname or
                   3180: 
                   3181: "first middle last generation"
                   3182: 
                   3183: if the user does not
                   3184: 
                   3185: =cut
1.66      www      3186: 
                   3187: sub nickname {
                   3188:     my ($uname,$udom)=@_;
1.537     albertel 3189:     return if (!defined($uname) || !defined($udom));
1.295     www      3190:     my %names=&getnames($uname,$udom);
1.68      albertel 3191:     my $name=$names{'nickname'};
1.66      www      3192:     if ($name) {
                   3193:        $name='&quot;'.$name.'&quot;'; 
                   3194:     } else {
                   3195:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3196: 	     $names{'lastname'}.' '.$names{'generation'};
                   3197:        $name=~s/\s+$//;
                   3198:        $name=~s/\s+/ /g;
                   3199:     }
                   3200:     return $name;
                   3201: }
                   3202: 
1.295     www      3203: sub getnames {
                   3204:     my ($uname,$udom)=@_;
1.537     albertel 3205:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3206:     if ($udom eq 'public' && $uname eq 'public') {
                   3207: 	return ('lastname' => &mt('Public'));
                   3208:     }
1.295     www      3209:     my $id=$uname.':'.$udom;
                   3210:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3211:     if ($cached) {
                   3212: 	return %{$names};
                   3213:     } else {
                   3214: 	my %loadnames=&Apache::lonnet::get('environment',
                   3215:                     ['firstname','middlename','lastname','generation','nickname'],
                   3216: 					 $udom,$uname);
                   3217: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3218: 	return %loadnames;
                   3219:     }
                   3220: }
1.61      www      3221: 
1.542     raeburn  3222: # -------------------------------------------------------------------- getemails
1.648     raeburn  3223: 
1.542     raeburn  3224: =pod
                   3225: 
1.648     raeburn  3226: =item * &getemails($uname,$udom)
1.542     raeburn  3227: 
                   3228: Gets a user's email information and returns it as a hash with keys:
                   3229: notification, critnotification, permanentemail
                   3230: 
                   3231: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3232: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3233:  
1.648     raeburn  3234: 
1.542     raeburn  3235: =cut
                   3236: 
1.648     raeburn  3237: 
1.466     albertel 3238: sub getemails {
                   3239:     my ($uname,$udom)=@_;
                   3240:     if ($udom eq 'public' && $uname eq 'public') {
                   3241: 	return;
                   3242:     }
1.467     www      3243:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3244:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3245:     my $id=$uname.':'.$udom;
                   3246:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3247:     if ($cached) {
                   3248: 	return %{$names};
                   3249:     } else {
                   3250: 	my %loadnames=&Apache::lonnet::get('environment',
                   3251:                     			   ['notification','critnotification',
                   3252: 					    'permanentemail'],
                   3253: 					   $udom,$uname);
                   3254: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3255: 	return %loadnames;
                   3256:     }
                   3257: }
                   3258: 
1.551     albertel 3259: sub flush_email_cache {
                   3260:     my ($uname,$udom)=@_;
                   3261:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3262:     if (!$uname) { $uname=$env{'user.name'};   }
                   3263:     return if ($udom eq 'public' && $uname eq 'public');
                   3264:     my $id=$uname.':'.$udom;
                   3265:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3266: }
                   3267: 
1.728     raeburn  3268: # -------------------------------------------------------------------- getlangs
                   3269: 
                   3270: =pod
                   3271: 
                   3272: =item * &getlangs($uname,$udom)
                   3273: 
                   3274: Gets a user's language preference and returns it as a hash with key:
                   3275: language.
                   3276: 
                   3277: =cut
                   3278: 
                   3279: 
                   3280: sub getlangs {
                   3281:     my ($uname,$udom) = @_;
                   3282:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3283:     if (!$uname) { $uname=$env{'user.name'};   }
                   3284:     my $id=$uname.':'.$udom;
                   3285:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3286:     if ($cached) {
                   3287:         return %{$langs};
                   3288:     } else {
                   3289:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3290:                                            $udom,$uname);
                   3291:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3292:         return %loadlangs;
                   3293:     }
                   3294: }
                   3295: 
                   3296: sub flush_langs_cache {
                   3297:     my ($uname,$udom)=@_;
                   3298:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3299:     if (!$uname) { $uname=$env{'user.name'};   }
                   3300:     return if ($udom eq 'public' && $uname eq 'public');
                   3301:     my $id=$uname.':'.$udom;
                   3302:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3303: }
                   3304: 
1.61      www      3305: # ------------------------------------------------------------------ Screenname
1.81      albertel 3306: 
                   3307: =pod
                   3308: 
1.648     raeburn  3309: =item * &screenname($uname,$udom)
1.81      albertel 3310: 
                   3311: Gets a users screenname and returns it as a string
                   3312: 
                   3313: =cut
1.61      www      3314: 
                   3315: sub screenname {
                   3316:     my ($uname,$udom)=@_;
1.258     albertel 3317:     if ($uname eq $env{'user.name'} &&
                   3318: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3319:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3320:     return $names{'screenname'};
1.62      www      3321: }
                   3322: 
1.212     albertel 3323: 
1.802     bisitz   3324: # ------------------------------------------------------------- Confirm Wrapper
                   3325: =pod
                   3326: 
1.1142    raeburn  3327: =item * &confirmwrapper($message)
1.802     bisitz   3328: 
                   3329: Wrap messages about completion of operation in box
                   3330: 
                   3331: =cut
                   3332: 
                   3333: sub confirmwrapper {
                   3334:     my ($message)=@_;
                   3335:     if ($message) {
                   3336:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3337:                .$message."\n"
                   3338:                .'</div>'."\n";
                   3339:     } else {
                   3340:         return $message;
                   3341:     }
                   3342: }
                   3343: 
1.62      www      3344: # ------------------------------------------------------------- Message Wrapper
                   3345: 
                   3346: sub messagewrapper {
1.369     www      3347:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3348:     return 
1.441     albertel 3349:         '<a href="/adm/email?compose=individual&amp;'.
                   3350:         'recname='.$username.'&amp;recdom='.$domain.
                   3351: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3352:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3353: }
1.802     bisitz   3354: 
1.74      www      3355: # --------------------------------------------------------------- Notes Wrapper
                   3356: 
                   3357: sub noteswrapper {
                   3358:     my ($link,$un,$do)=@_;
                   3359:     return 
1.896     amueller 3360: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3361: }
1.802     bisitz   3362: 
1.62      www      3363: # ------------------------------------------------------------- Aboutme Wrapper
                   3364: 
                   3365: sub aboutmewrapper {
1.1070    raeburn  3366:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3367:     if (!defined($username)  && !defined($domain)) {
                   3368:         return;
                   3369:     }
1.1096    raeburn  3370:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3371: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3372: }
                   3373: 
                   3374: # ------------------------------------------------------------ Syllabus Wrapper
                   3375: 
                   3376: sub syllabuswrapper {
1.707     bisitz   3377:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3378:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3379: }
1.14      harris41 3380: 
1.802     bisitz   3381: # -----------------------------------------------------------------------------
                   3382: 
1.208     matthew  3383: sub track_student_link {
1.887     raeburn  3384:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3385:     my $link ="/adm/trackstudent?";
1.208     matthew  3386:     my $title = 'View recent activity';
                   3387:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3388:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3389:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3390:         $title .= ' of this student';
1.268     albertel 3391:     } 
1.208     matthew  3392:     if (defined($target) && $target !~ /^\s*$/) {
                   3393:         $target = qq{target="$target"};
                   3394:     } else {
                   3395:         $target = '';
                   3396:     }
1.268     albertel 3397:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3398:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3399:     $title = &mt($title);
                   3400:     $linktext = &mt($linktext);
1.448     albertel 3401:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3402: 	&help_open_topic('View_recent_activity');
1.208     matthew  3403: }
                   3404: 
1.781     raeburn  3405: sub slot_reservations_link {
                   3406:     my ($linktext,$sname,$sdom,$target) = @_;
                   3407:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3408:     my $title = 'View slot reservation history';
                   3409:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3410:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3411:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3412:         $title .= ' of this student';
                   3413:     }
                   3414:     if (defined($target) && $target !~ /^\s*$/) {
                   3415:         $target = qq{target="$target"};
                   3416:     } else {
                   3417:         $target = '';
                   3418:     }
                   3419:     $title = &mt($title);
                   3420:     $linktext = &mt($linktext);
                   3421:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3422: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3423: 
                   3424: }
                   3425: 
1.508     www      3426: # ===================================================== Display a student photo
                   3427: 
                   3428: 
1.509     albertel 3429: sub student_image_tag {
1.508     www      3430:     my ($domain,$user)=@_;
                   3431:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3432:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3433: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3434:     } else {
                   3435: 	return '';
                   3436:     }
                   3437: }
                   3438: 
1.112     bowersj2 3439: =pod
                   3440: 
                   3441: =back
                   3442: 
                   3443: =head1 Access .tab File Data
                   3444: 
                   3445: =over 4
                   3446: 
1.648     raeburn  3447: =item * &languageids() 
1.112     bowersj2 3448: 
                   3449: returns list of all language ids
                   3450: 
                   3451: =cut
                   3452: 
1.14      harris41 3453: sub languageids {
1.16      harris41 3454:     return sort(keys(%language));
1.14      harris41 3455: }
                   3456: 
1.112     bowersj2 3457: =pod
                   3458: 
1.648     raeburn  3459: =item * &languagedescription() 
1.112     bowersj2 3460: 
                   3461: returns description of a specified language id
                   3462: 
                   3463: =cut
                   3464: 
1.14      harris41 3465: sub languagedescription {
1.125     www      3466:     my $code=shift;
                   3467:     return  ($supported_language{$code}?'* ':'').
                   3468:             $language{$code}.
1.126     www      3469: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3470: }
                   3471: 
1.1048    foxr     3472: =pod
                   3473: 
                   3474: =item * &plainlanguagedescription
                   3475: 
                   3476: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3477: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3478: 
                   3479: =cut
                   3480: 
1.145     www      3481: sub plainlanguagedescription {
                   3482:     my $code=shift;
                   3483:     return $language{$code};
                   3484: }
                   3485: 
1.1048    foxr     3486: =pod
                   3487: 
                   3488: =item * &supportedlanguagecode
                   3489: 
                   3490: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3491: code.
                   3492: 
                   3493: =cut
                   3494: 
1.145     www      3495: sub supportedlanguagecode {
                   3496:     my $code=shift;
                   3497:     return $supported_language{$code};
1.97      www      3498: }
                   3499: 
1.112     bowersj2 3500: =pod
                   3501: 
1.1048    foxr     3502: =item * &latexlanguage()
                   3503: 
                   3504: Given a language key code returns the correspondnig language to use
                   3505: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3506: is no supported hyphenation for the language code.
                   3507: 
                   3508: =cut
                   3509: 
                   3510: sub latexlanguage {
                   3511:     my $code = shift;
                   3512:     return $latex_language{$code};
                   3513: }
                   3514: 
                   3515: =pod
                   3516: 
                   3517: =item * &latexhyphenation()
                   3518: 
                   3519: Same as above but what's supplied is the language as it might be stored
                   3520: in the metadata.
                   3521: 
                   3522: =cut
                   3523: 
                   3524: sub latexhyphenation {
                   3525:     my $key = shift;
                   3526:     return $latex_language_bykey{$key};
                   3527: }
                   3528: 
                   3529: =pod
                   3530: 
1.648     raeburn  3531: =item * &copyrightids() 
1.112     bowersj2 3532: 
                   3533: returns list of all copyrights
                   3534: 
                   3535: =cut
                   3536: 
                   3537: sub copyrightids {
                   3538:     return sort(keys(%cprtag));
                   3539: }
                   3540: 
                   3541: =pod
                   3542: 
1.648     raeburn  3543: =item * &copyrightdescription() 
1.112     bowersj2 3544: 
                   3545: returns description of a specified copyright id
                   3546: 
                   3547: =cut
                   3548: 
                   3549: sub copyrightdescription {
1.166     www      3550:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3551: }
1.197     matthew  3552: 
                   3553: =pod
                   3554: 
1.648     raeburn  3555: =item * &source_copyrightids() 
1.192     taceyjo1 3556: 
                   3557: returns list of all source copyrights
                   3558: 
                   3559: =cut
                   3560: 
                   3561: sub source_copyrightids {
                   3562:     return sort(keys(%scprtag));
                   3563: }
                   3564: 
                   3565: =pod
                   3566: 
1.648     raeburn  3567: =item * &source_copyrightdescription() 
1.192     taceyjo1 3568: 
                   3569: returns description of a specified source copyright id
                   3570: 
                   3571: =cut
                   3572: 
                   3573: sub source_copyrightdescription {
                   3574:     return &mt($scprtag{shift(@_)});
                   3575: }
1.112     bowersj2 3576: 
                   3577: =pod
                   3578: 
1.648     raeburn  3579: =item * &filecategories() 
1.112     bowersj2 3580: 
                   3581: returns list of all file categories
                   3582: 
                   3583: =cut
                   3584: 
                   3585: sub filecategories {
                   3586:     return sort(keys(%category_extensions));
                   3587: }
                   3588: 
                   3589: =pod
                   3590: 
1.648     raeburn  3591: =item * &filecategorytypes() 
1.112     bowersj2 3592: 
                   3593: returns list of file types belonging to a given file
                   3594: category
                   3595: 
                   3596: =cut
                   3597: 
                   3598: sub filecategorytypes {
1.356     albertel 3599:     my ($cat) = @_;
                   3600:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3601: }
                   3602: 
                   3603: =pod
                   3604: 
1.648     raeburn  3605: =item * &fileembstyle() 
1.112     bowersj2 3606: 
                   3607: returns embedding style for a specified file type
                   3608: 
                   3609: =cut
                   3610: 
                   3611: sub fileembstyle {
                   3612:     return $fe{lc(shift(@_))};
1.169     www      3613: }
                   3614: 
1.351     www      3615: sub filemimetype {
                   3616:     return $fm{lc(shift(@_))};
                   3617: }
                   3618: 
1.169     www      3619: 
                   3620: sub filecategoryselect {
                   3621:     my ($name,$value)=@_;
1.189     matthew  3622:     return &select_form($value,$name,
1.970     raeburn  3623:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3624: }
                   3625: 
                   3626: =pod
                   3627: 
1.648     raeburn  3628: =item * &filedescription() 
1.112     bowersj2 3629: 
                   3630: returns description for a specified file type
                   3631: 
                   3632: =cut
                   3633: 
                   3634: sub filedescription {
1.188     matthew  3635:     my $file_description = $fd{lc(shift())};
                   3636:     $file_description =~ s:([\[\]]):~$1:g;
                   3637:     return &mt($file_description);
1.112     bowersj2 3638: }
                   3639: 
                   3640: =pod
                   3641: 
1.648     raeburn  3642: =item * &filedescriptionex() 
1.112     bowersj2 3643: 
                   3644: returns description for a specified file type with
                   3645: extra formatting
                   3646: 
                   3647: =cut
                   3648: 
                   3649: sub filedescriptionex {
                   3650:     my $ex=shift;
1.188     matthew  3651:     my $file_description = $fd{lc($ex)};
                   3652:     $file_description =~ s:([\[\]]):~$1:g;
                   3653:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3654: }
                   3655: 
                   3656: # End of .tab access
                   3657: =pod
                   3658: 
                   3659: =back
                   3660: 
                   3661: =cut
                   3662: 
                   3663: # ------------------------------------------------------------------ File Types
                   3664: sub fileextensions {
                   3665:     return sort(keys(%fe));
                   3666: }
                   3667: 
1.97      www      3668: # ----------------------------------------------------------- Display Languages
                   3669: # returns a hash with all desired display languages
                   3670: #
                   3671: 
                   3672: sub display_languages {
                   3673:     my %languages=();
1.695     raeburn  3674:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3675: 	$languages{$lang}=1;
1.97      www      3676:     }
                   3677:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3678:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3679: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3680: 	    $languages{$lang}=1;
1.97      www      3681:         }
                   3682:     }
                   3683:     return %languages;
1.14      harris41 3684: }
                   3685: 
1.582     albertel 3686: sub languages {
                   3687:     my ($possible_langs) = @_;
1.695     raeburn  3688:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3689:     if (!ref($possible_langs)) {
                   3690: 	if( wantarray ) {
                   3691: 	    return @preferred_langs;
                   3692: 	} else {
                   3693: 	    return $preferred_langs[0];
                   3694: 	}
                   3695:     }
                   3696:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3697:     my @preferred_possibilities;
                   3698:     foreach my $preferred_lang (@preferred_langs) {
                   3699: 	if (exists($possibilities{$preferred_lang})) {
                   3700: 	    push(@preferred_possibilities, $preferred_lang);
                   3701: 	}
                   3702:     }
                   3703:     if( wantarray ) {
                   3704: 	return @preferred_possibilities;
                   3705:     }
                   3706:     return $preferred_possibilities[0];
                   3707: }
                   3708: 
1.742     raeburn  3709: sub user_lang {
                   3710:     my ($touname,$toudom,$fromcid) = @_;
                   3711:     my @userlangs;
                   3712:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3713:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3714:                     $env{'course.'.$fromcid.'.languages'}));
                   3715:     } else {
                   3716:         my %langhash = &getlangs($touname,$toudom);
                   3717:         if ($langhash{'languages'} ne '') {
                   3718:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3719:         } else {
                   3720:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3721:             if ($domdefs{'lang_def'} ne '') {
                   3722:                 @userlangs = ($domdefs{'lang_def'});
                   3723:             }
                   3724:         }
                   3725:     }
                   3726:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3727:     my $user_lh = Apache::localize->get_handle(@languages);
                   3728:     return $user_lh;
                   3729: }
                   3730: 
                   3731: 
1.112     bowersj2 3732: ###############################################################
                   3733: ##               Student Answer Attempts                     ##
                   3734: ###############################################################
                   3735: 
                   3736: =pod
                   3737: 
                   3738: =head1 Alternate Problem Views
                   3739: 
                   3740: =over 4
                   3741: 
1.648     raeburn  3742: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3743:     $getattempt, $regexp, $gradesub)
                   3744: 
                   3745: Return string with previous attempt on problem. Arguments:
                   3746: 
                   3747: =over 4
                   3748: 
                   3749: =item * $symb: Problem, including path
                   3750: 
                   3751: =item * $username: username of the desired student
                   3752: 
                   3753: =item * $domain: domain of the desired student
1.14      harris41 3754: 
1.112     bowersj2 3755: =item * $course: Course ID
1.14      harris41 3756: 
1.112     bowersj2 3757: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3758:     something
1.14      harris41 3759: 
1.112     bowersj2 3760: =item * $regexp: if string matches this regexp, the string will be
                   3761:     sent to $gradesub
1.14      harris41 3762: 
1.112     bowersj2 3763: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3764: 
1.112     bowersj2 3765: =back
1.14      harris41 3766: 
1.112     bowersj2 3767: The output string is a table containing all desired attempts, if any.
1.16      harris41 3768: 
1.112     bowersj2 3769: =cut
1.1       albertel 3770: 
                   3771: sub get_previous_attempt {
1.43      ng       3772:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3773:   my $prevattempts='';
1.43      ng       3774:   no strict 'refs';
1.1       albertel 3775:   if ($symb) {
1.3       albertel 3776:     my (%returnhash)=
                   3777:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3778:     if ($returnhash{'version'}) {
                   3779:       my %lasthash=();
                   3780:       my $version;
                   3781:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3782:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3783: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3784:         }
1.1       albertel 3785:       }
1.596     albertel 3786:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3787:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3788:       my (%typeparts,%lasthidden);
1.945     raeburn  3789:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3790:       foreach my $key (sort(keys(%lasthash))) {
                   3791: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3792: 	if ($#parts > 0) {
1.31      albertel 3793: 	  my $data=$parts[-1];
1.989     raeburn  3794:           next if ($data eq 'foilorder');
1.31      albertel 3795: 	  pop(@parts);
1.1010    www      3796:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3797:           if ($data eq 'type') {
                   3798:               unless ($showsurv) {
                   3799:                   my $id = join(',',@parts);
                   3800:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3801:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3802:                       $lasthidden{$ign.'.'.$id} = 1;
                   3803:                   }
1.945     raeburn  3804:               }
1.1010    www      3805:           } 
1.31      albertel 3806: 	} else {
1.41      ng       3807: 	  if ($#parts == 0) {
                   3808: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3809: 	  } else {
                   3810: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3811: 	  }
1.31      albertel 3812: 	}
1.16      harris41 3813:       }
1.596     albertel 3814:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3815:       if ($getattempt eq '') {
                   3816: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3817:             my @hidden;
                   3818:             if (%typeparts) {
                   3819:                 foreach my $id (keys(%typeparts)) {
                   3820:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3821:                         push(@hidden,$id);
                   3822:                     }
                   3823:                 }
                   3824:             }
                   3825:             $prevattempts.=&start_data_table_row().
                   3826:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3827:             if (@hidden) {
                   3828:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3829:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3830:                     my $hide;
                   3831:                     foreach my $id (@hidden) {
                   3832:                         if ($key =~ /^\Q$id\E/) {
                   3833:                             $hide = 1;
                   3834:                             last;
                   3835:                         }
                   3836:                     }
                   3837:                     if ($hide) {
                   3838:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3839:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3840:                             my $value = &format_previous_attempt_value($key,
                   3841:                                              $returnhash{$version.':'.$key});
                   3842:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3843:                         } else {
                   3844:                             $prevattempts.='<td>&nbsp;</td>';
                   3845:                         }
                   3846:                     } else {
                   3847:                         if ($key =~ /\./) {
                   3848:                             my $value = &format_previous_attempt_value($key,
                   3849:                                               $returnhash{$version.':'.$key});
                   3850:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3851:                         } else {
                   3852:                             $prevattempts.='<td>&nbsp;</td>';
                   3853:                         }
                   3854:                     }
                   3855:                 }
                   3856:             } else {
                   3857: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3858:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3859: 		    my $value = &format_previous_attempt_value($key,
                   3860: 			            $returnhash{$version.':'.$key});
                   3861: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3862: 	        }
                   3863:             }
                   3864: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3865: 	 }
1.1       albertel 3866:       }
1.945     raeburn  3867:       my @currhidden = keys(%lasthidden);
1.596     albertel 3868:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3869:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3870:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3871:           if (%typeparts) {
                   3872:               my $hidden;
                   3873:               foreach my $id (@currhidden) {
                   3874:                   if ($key =~ /^\Q$id\E/) {
                   3875:                       $hidden = 1;
                   3876:                       last;
                   3877:                   }
                   3878:               }
                   3879:               if ($hidden) {
                   3880:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3881:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3882:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3883:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3884:                           $value = &$gradesub($value);
                   3885:                       }
                   3886:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3887:                   } else {
                   3888:                       $prevattempts.='<td>&nbsp;</td>';
                   3889:                   }
                   3890:               } else {
                   3891:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3892:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3893:                       $value = &$gradesub($value);
                   3894:                   }
                   3895:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3896:               }
                   3897:           } else {
                   3898: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3899: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3900:                   $value = &$gradesub($value);
                   3901:               }
                   3902: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3903:           }
1.16      harris41 3904:       }
1.596     albertel 3905:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3906:     } else {
1.596     albertel 3907:       $prevattempts=
                   3908: 	  &start_data_table().&start_data_table_row().
                   3909: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3910: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3911:     }
                   3912:   } else {
1.596     albertel 3913:     $prevattempts=
                   3914: 	  &start_data_table().&start_data_table_row().
                   3915: 	  '<td>'.&mt('No data.').'</td>'.
                   3916: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3917:   }
1.10      albertel 3918: }
                   3919: 
1.581     albertel 3920: sub format_previous_attempt_value {
                   3921:     my ($key,$value) = @_;
1.1011    www      3922:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3923: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3924:     } elsif (ref($value) eq 'ARRAY') {
                   3925: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3926:     } elsif ($key =~ /answerstring$/) {
                   3927:         my %answers = &Apache::lonnet::str2hash($value);
                   3928:         my @anskeys = sort(keys(%answers));
                   3929:         if (@anskeys == 1) {
                   3930:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3931:             if ($answer =~ m{\0}) {
                   3932:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3933:             }
                   3934:             my $tag_internal_answer_name = 'INTERNAL';
                   3935:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3936:                 $value = $answer; 
                   3937:             } else {
                   3938:                 $value = $anskeys[0].'='.$answer;
                   3939:             }
                   3940:         } else {
                   3941:             foreach my $ans (@anskeys) {
                   3942:                 my $answer = $answers{$ans};
1.1001    raeburn  3943:                 if ($answer =~ m{\0}) {
                   3944:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3945:                 }
                   3946:                 $value .=  $ans.'='.$answer.'<br />';;
                   3947:             } 
                   3948:         }
1.581     albertel 3949:     } else {
                   3950: 	$value = &unescape($value);
                   3951:     }
                   3952:     return $value;
                   3953: }
                   3954: 
                   3955: 
1.107     albertel 3956: sub relative_to_absolute {
                   3957:     my ($url,$output)=@_;
                   3958:     my $parser=HTML::TokeParser->new(\$output);
                   3959:     my $token;
                   3960:     my $thisdir=$url;
                   3961:     my @rlinks=();
                   3962:     while ($token=$parser->get_token) {
                   3963: 	if ($token->[0] eq 'S') {
                   3964: 	    if ($token->[1] eq 'a') {
                   3965: 		if ($token->[2]->{'href'}) {
                   3966: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3967: 		}
                   3968: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3969: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3970: 	    } elsif ($token->[1] eq 'base') {
                   3971: 		$thisdir=$token->[2]->{'href'};
                   3972: 	    }
                   3973: 	}
                   3974:     }
                   3975:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3976:     foreach my $link (@rlinks) {
1.726     raeburn  3977: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3978: 		($link=~/^\//) ||
                   3979: 		($link=~/^javascript:/i) ||
                   3980: 		($link=~/^mailto:/i) ||
                   3981: 		($link=~/^\#/)) {
                   3982: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3983: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3984: 	}
                   3985:     }
                   3986: # -------------------------------------------------- Deal with Applet codebases
                   3987:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3988:     return $output;
                   3989: }
                   3990: 
1.112     bowersj2 3991: =pod
                   3992: 
1.648     raeburn  3993: =item * &get_student_view()
1.112     bowersj2 3994: 
                   3995: show a snapshot of what student was looking at
                   3996: 
                   3997: =cut
                   3998: 
1.10      albertel 3999: sub get_student_view {
1.186     albertel 4000:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4001:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4002:   my (%form);
1.10      albertel 4003:   my @elements=('symb','courseid','domain','username');
                   4004:   foreach my $element (@elements) {
1.186     albertel 4005:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4006:   }
1.186     albertel 4007:   if (defined($moreenv)) {
                   4008:       %form=(%form,%{$moreenv});
                   4009:   }
1.236     albertel 4010:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4011:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4012:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4013:   $userview=~s/\<body[^\>]*\>//gi;
                   4014:   $userview=~s/\<\/body\>//gi;
                   4015:   $userview=~s/\<html\>//gi;
                   4016:   $userview=~s/\<\/html\>//gi;
                   4017:   $userview=~s/\<head\>//gi;
                   4018:   $userview=~s/\<\/head\>//gi;
                   4019:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4020:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4021:   if (wantarray) {
                   4022:      return ($userview,$response);
                   4023:   } else {
                   4024:      return $userview;
                   4025:   }
                   4026: }
                   4027: 
                   4028: sub get_student_view_with_retries {
                   4029:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4030: 
                   4031:     my $ok = 0;                 # True if we got a good response.
                   4032:     my $content;
                   4033:     my $response;
                   4034: 
                   4035:     # Try to get the student_view done. within the retries count:
                   4036:     
                   4037:     do {
                   4038:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4039:          $ok      = $response->is_success;
                   4040:          if (!$ok) {
                   4041:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4042:          }
                   4043:          $retries--;
                   4044:     } while (!$ok && ($retries > 0));
                   4045:     
                   4046:     if (!$ok) {
                   4047:        $content = '';          # On error return an empty content.
                   4048:     }
1.651     www      4049:     if (wantarray) {
                   4050:        return ($content, $response);
                   4051:     } else {
                   4052:        return $content;
                   4053:     }
1.11      albertel 4054: }
                   4055: 
1.112     bowersj2 4056: =pod
                   4057: 
1.648     raeburn  4058: =item * &get_student_answers() 
1.112     bowersj2 4059: 
                   4060: show a snapshot of how student was answering problem
                   4061: 
                   4062: =cut
                   4063: 
1.11      albertel 4064: sub get_student_answers {
1.100     sakharuk 4065:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4066:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4067:   my (%moreenv);
1.11      albertel 4068:   my @elements=('symb','courseid','domain','username');
                   4069:   foreach my $element (@elements) {
1.186     albertel 4070:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4071:   }
1.186     albertel 4072:   $moreenv{'grade_target'}='answer';
                   4073:   %moreenv=(%form,%moreenv);
1.497     raeburn  4074:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4075:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4076:   return $userview;
1.1       albertel 4077: }
1.116     albertel 4078: 
                   4079: =pod
                   4080: 
                   4081: =item * &submlink()
                   4082: 
1.242     albertel 4083: Inputs: $text $uname $udom $symb $target
1.116     albertel 4084: 
                   4085: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4086: 
                   4087: =cut
                   4088: 
                   4089: ###############################################
                   4090: sub submlink {
1.242     albertel 4091:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4092:     if (!($uname && $udom)) {
                   4093: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4094: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4095: 	if (!$symb) { $symb=$cursymb; }
                   4096:     }
1.254     matthew  4097:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4098:     $symb=&escape($symb);
1.960     bisitz   4099:     if ($target) { $target=" target=\"$target\""; }
                   4100:     return
                   4101:         '<a href="/adm/grades?command=submission'.
                   4102:         '&amp;symb='.$symb.
                   4103:         '&amp;student='.$uname.
                   4104:         '&amp;userdom='.$udom.'"'.
                   4105:         $target.'>'.$text.'</a>';
1.242     albertel 4106: }
                   4107: ##############################################
                   4108: 
                   4109: =pod
                   4110: 
                   4111: =item * &pgrdlink()
                   4112: 
                   4113: Inputs: $text $uname $udom $symb $target
                   4114: 
                   4115: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4116: 
                   4117: =cut
                   4118: 
                   4119: ###############################################
                   4120: sub pgrdlink {
                   4121:     my $link=&submlink(@_);
                   4122:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4123:     return $link;
                   4124: }
                   4125: ##############################################
                   4126: 
                   4127: =pod
                   4128: 
                   4129: =item * &pprmlink()
                   4130: 
                   4131: Inputs: $text $uname $udom $symb $target
                   4132: 
                   4133: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4134: student and a specific resource
1.242     albertel 4135: 
                   4136: =cut
                   4137: 
                   4138: ###############################################
                   4139: sub pprmlink {
                   4140:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4141:     if (!($uname && $udom)) {
                   4142: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4143: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4144: 	if (!$symb) { $symb=$cursymb; }
                   4145:     }
1.254     matthew  4146:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4147:     $symb=&escape($symb);
1.242     albertel 4148:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4149:     return '<a href="/adm/parmset?command=set&amp;'.
                   4150: 	'symb='.$symb.'&amp;uname='.$uname.
                   4151: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4152: }
                   4153: ##############################################
1.37      matthew  4154: 
1.112     bowersj2 4155: =pod
                   4156: 
                   4157: =back
                   4158: 
                   4159: =cut
                   4160: 
1.37      matthew  4161: ###############################################
1.51      www      4162: 
                   4163: 
                   4164: sub timehash {
1.687     raeburn  4165:     my ($thistime) = @_;
                   4166:     my $timezone = &Apache::lonlocal::gettimezone();
                   4167:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4168:                      ->set_time_zone($timezone);
                   4169:     my $wday = $dt->day_of_week();
                   4170:     if ($wday == 7) { $wday = 0; }
                   4171:     return ( 'second' => $dt->second(),
                   4172:              'minute' => $dt->minute(),
                   4173:              'hour'   => $dt->hour(),
                   4174:              'day'     => $dt->day_of_month(),
                   4175:              'month'   => $dt->month(),
                   4176:              'year'    => $dt->year(),
                   4177:              'weekday' => $wday,
                   4178:              'dayyear' => $dt->day_of_year(),
                   4179:              'dlsav'   => $dt->is_dst() );
1.51      www      4180: }
                   4181: 
1.370     www      4182: sub utc_string {
                   4183:     my ($date)=@_;
1.371     www      4184:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4185: }
                   4186: 
1.51      www      4187: sub maketime {
                   4188:     my %th=@_;
1.687     raeburn  4189:     my ($epoch_time,$timezone,$dt);
                   4190:     $timezone = &Apache::lonlocal::gettimezone();
                   4191:     eval {
                   4192:         $dt = DateTime->new( year   => $th{'year'},
                   4193:                              month  => $th{'month'},
                   4194:                              day    => $th{'day'},
                   4195:                              hour   => $th{'hour'},
                   4196:                              minute => $th{'minute'},
                   4197:                              second => $th{'second'},
                   4198:                              time_zone => $timezone,
                   4199:                          );
                   4200:     };
                   4201:     if (!$@) {
                   4202:         $epoch_time = $dt->epoch;
                   4203:         if ($epoch_time) {
                   4204:             return $epoch_time;
                   4205:         }
                   4206:     }
1.51      www      4207:     return POSIX::mktime(
                   4208:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4209:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4210: }
                   4211: 
                   4212: #########################################
1.51      www      4213: 
                   4214: sub findallcourses {
1.482     raeburn  4215:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4216:     my %roles;
                   4217:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4218:     my %courses;
1.51      www      4219:     my $now=time;
1.482     raeburn  4220:     if (!defined($uname)) {
                   4221:         $uname = $env{'user.name'};
                   4222:     }
                   4223:     if (!defined($udom)) {
                   4224:         $udom = $env{'user.domain'};
                   4225:     }
                   4226:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4227:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4228:         if (!%roles) {
                   4229:             %roles = (
                   4230:                        cc => 1,
1.907     raeburn  4231:                        co => 1,
1.482     raeburn  4232:                        in => 1,
                   4233:                        ep => 1,
                   4234:                        ta => 1,
                   4235:                        cr => 1,
                   4236:                        st => 1,
                   4237:              );
                   4238:         }
                   4239:         foreach my $entry (keys(%roleshash)) {
                   4240:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4241:             if ($trole =~ /^cr/) { 
                   4242:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4243:             } else {
                   4244:                 next if (!exists($roles{$trole}));
                   4245:             }
                   4246:             if ($tend) {
                   4247:                 next if ($tend < $now);
                   4248:             }
                   4249:             if ($tstart) {
                   4250:                 next if ($tstart > $now);
                   4251:             }
1.1058    raeburn  4252:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4253:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4254:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4255:             if ($secpart eq '') {
                   4256:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4257:                 $sec = 'none';
1.1058    raeburn  4258:                 $value .= $cnum.'/';
1.482     raeburn  4259:             } else {
                   4260:                 $cnum = $cnumpart;
                   4261:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4262:                 $value .= $cnum.'/'.$sec;
                   4263:             }
                   4264:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4265:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4266:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4267:                 }
                   4268:             } else {
                   4269:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4270:             }
1.482     raeburn  4271:         }
                   4272:     } else {
                   4273:         foreach my $key (keys(%env)) {
1.483     albertel 4274: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4275:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4276: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4277: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4278: 	        next if (%roles && !exists($roles{$role}));
                   4279: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4280:                 my $active=1;
                   4281:                 if ($starttime) {
                   4282: 		    if ($now<$starttime) { $active=0; }
                   4283:                 }
                   4284:                 if ($endtime) {
                   4285:                     if ($now>$endtime) { $active=0; }
                   4286:                 }
                   4287:                 if ($active) {
1.1058    raeburn  4288:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4289:                     if ($sec eq '') {
                   4290:                         $sec = 'none';
1.1058    raeburn  4291:                     } else {
                   4292:                         $value .= $sec;
                   4293:                     }
                   4294:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4295:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4296:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4297:                         }
                   4298:                     } else {
                   4299:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4300:                     }
1.474     raeburn  4301:                 }
                   4302:             }
1.51      www      4303:         }
                   4304:     }
1.474     raeburn  4305:     return %courses;
1.51      www      4306: }
1.37      matthew  4307: 
1.54      www      4308: ###############################################
1.474     raeburn  4309: 
                   4310: sub blockcheck {
1.1062    raeburn  4311:     my ($setters,$activity,$uname,$udom,$url) = @_;
1.490     raeburn  4312: 
                   4313:     if (!defined($udom)) {
                   4314:         $udom = $env{'user.domain'};
                   4315:     }
                   4316:     if (!defined($uname)) {
                   4317:         $uname = $env{'user.name'};
                   4318:     }
                   4319: 
                   4320:     # If uname and udom are for a course, check for blocks in the course.
                   4321: 
                   4322:     if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062    raeburn  4323:         my ($startblock,$endblock,$triggerblock) = 
                   4324:             &get_blocks($setters,$activity,$udom,$uname,$url);
                   4325:         return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4326:     }
1.474     raeburn  4327: 
1.502     raeburn  4328:     my $startblock = 0;
                   4329:     my $endblock = 0;
1.1062    raeburn  4330:     my $triggerblock = '';
1.482     raeburn  4331:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4332: 
1.490     raeburn  4333:     # If uname is for a user, and activity is course-specific, i.e.,
                   4334:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4335: 
1.490     raeburn  4336:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4337:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4338:         foreach my $key (keys(%live_courses)) {
                   4339:             if ($key ne $env{'request.course.id'}) {
                   4340:                 delete($live_courses{$key});
                   4341:             }
                   4342:         }
                   4343:     }
                   4344: 
                   4345:     my $otheruser = 0;
                   4346:     my %own_courses;
                   4347:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4348:         # Resource belongs to user other than current user.
                   4349:         $otheruser = 1;
                   4350:         # Gather courses for current user
                   4351:         %own_courses = 
                   4352:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4353:     }
                   4354: 
                   4355:     # Gather active course roles - course coordinator, instructor, 
                   4356:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4357: 
                   4358:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4359:         my ($cdom,$cnum);
                   4360:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4361:             $cdom = $env{'course.'.$course.'.domain'};
                   4362:             $cnum = $env{'course.'.$course.'.num'};
                   4363:         } else {
1.490     raeburn  4364:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4365:         }
                   4366:         my $no_ownblock = 0;
                   4367:         my $no_userblock = 0;
1.533     raeburn  4368:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4369:             # Check if current user has 'evb' priv for this
                   4370:             if (defined($own_courses{$course})) {
                   4371:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4372:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4373:                     if ($sec ne 'none') {
                   4374:                         $checkrole .= '/'.$sec;
                   4375:                     }
                   4376:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4377:                         $no_ownblock = 1;
                   4378:                         last;
                   4379:                     }
                   4380:                 }
                   4381:             }
                   4382:             # if they have 'evb' priv and are currently not playing student
                   4383:             next if (($no_ownblock) &&
                   4384:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4385:         }
1.474     raeburn  4386:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4387:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4388:             if ($sec ne 'none') {
1.482     raeburn  4389:                 $checkrole .= '/'.$sec;
1.474     raeburn  4390:             }
1.490     raeburn  4391:             if ($otheruser) {
                   4392:                 # Resource belongs to user other than current user.
                   4393:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4394:                 my (%allroles,%userroles);
                   4395:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4396:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4397:                         my ($trole,$tdom,$tnum,$tsec);
                   4398:                         if ($entry =~ /^cr/) {
                   4399:                             ($trole,$tdom,$tnum,$tsec) = 
                   4400:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4401:                         } else {
                   4402:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4403:                         }
                   4404:                         my ($spec,$area,$trest);
                   4405:                         $area = '/'.$tdom.'/'.$tnum;
                   4406:                         $trest = $tnum;
                   4407:                         if ($tsec ne '') {
                   4408:                             $area .= '/'.$tsec;
                   4409:                             $trest .= '/'.$tsec;
                   4410:                         }
                   4411:                         $spec = $trole.'.'.$area;
                   4412:                         if ($trole =~ /^cr/) {
                   4413:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4414:                                                               $tdom,$spec,$trest,$area);
                   4415:                         } else {
                   4416:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4417:                                                                 $tdom,$spec,$trest,$area);
                   4418:                         }
                   4419:                     }
                   4420:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4421:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4422:                         if ($1) {
                   4423:                             $no_userblock = 1;
                   4424:                             last;
                   4425:                         }
1.486     raeburn  4426:                     }
                   4427:                 }
1.490     raeburn  4428:             } else {
                   4429:                 # Resource belongs to current user
                   4430:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4431:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4432:                     $no_ownblock = 1;
                   4433:                     last;
                   4434:                 }
1.474     raeburn  4435:             }
                   4436:         }
                   4437:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4438:         next if (($no_ownblock) &&
1.491     albertel 4439:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4440:         next if ($no_userblock);
1.474     raeburn  4441: 
1.866     kalberla 4442:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4443:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4444:         
1.1062    raeburn  4445:         my ($start,$end,$trigger) = 
                   4446:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4447:         if (($start != 0) && 
                   4448:             (($startblock == 0) || ($startblock > $start))) {
                   4449:             $startblock = $start;
1.1062    raeburn  4450:             if ($trigger ne '') {
                   4451:                 $triggerblock = $trigger;
                   4452:             }
1.502     raeburn  4453:         }
                   4454:         if (($end != 0)  &&
                   4455:             (($endblock == 0) || ($endblock < $end))) {
                   4456:             $endblock = $end;
1.1062    raeburn  4457:             if ($trigger ne '') {
                   4458:                 $triggerblock = $trigger;
                   4459:             }
1.502     raeburn  4460:         }
1.490     raeburn  4461:     }
1.1062    raeburn  4462:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4463: }
                   4464: 
                   4465: sub get_blocks {
1.1062    raeburn  4466:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4467:     my $startblock = 0;
                   4468:     my $endblock = 0;
1.1062    raeburn  4469:     my $triggerblock = '';
1.490     raeburn  4470:     my $course = $cdom.'_'.$cnum;
                   4471:     $setters->{$course} = {};
                   4472:     $setters->{$course}{'staff'} = [];
                   4473:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4474:     $setters->{$course}{'triggers'} = [];
                   4475:     my (@blockers,%triggered);
                   4476:     my $now = time;
                   4477:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4478:     if ($activity eq 'docs') {
                   4479:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4480:         foreach my $block (@blockers) {
                   4481:             if ($block =~ /^firstaccess____(.+)$/) {
                   4482:                 my $item = $1;
                   4483:                 my $type = 'map';
                   4484:                 my $timersymb = $item;
                   4485:                 if ($item eq 'course') {
                   4486:                     $type = 'course';
                   4487:                 } elsif ($item =~ /___\d+___/) {
                   4488:                     $type = 'resource';
                   4489:                 } else {
                   4490:                     $timersymb = &Apache::lonnet::symbread($item);
                   4491:                 }
                   4492:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4493:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4494:                 $triggered{$block} = {
                   4495:                                        start => $start,
                   4496:                                        end   => $end,
                   4497:                                        type  => $type,
                   4498:                                      };
                   4499:             }
                   4500:         }
                   4501:     } else {
                   4502:         foreach my $block (keys(%commblocks)) {
                   4503:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4504:                 my ($start,$end) = ($1,$2);
                   4505:                 if ($start <= time && $end >= time) {
                   4506:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4507:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4508:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4509:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4510:                                     push(@blockers,$block);
                   4511:                                 }
                   4512:                             }
                   4513:                         }
                   4514:                     }
                   4515:                 }
                   4516:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4517:                 my $item = $1;
                   4518:                 my $timersymb = $item; 
                   4519:                 my $type = 'map';
                   4520:                 if ($item eq 'course') {
                   4521:                     $type = 'course';
                   4522:                 } elsif ($item =~ /___\d+___/) {
                   4523:                     $type = 'resource';
                   4524:                 } else {
                   4525:                     $timersymb = &Apache::lonnet::symbread($item);
                   4526:                 }
                   4527:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4528:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4529:                 if ($start && $end) {
                   4530:                     if (($start <= time) && ($end >= time)) {
                   4531:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4532:                             push(@blockers,$block);
                   4533:                             $triggered{$block} = {
                   4534:                                                    start => $start,
                   4535:                                                    end   => $end,
                   4536:                                                    type  => $type,
                   4537:                                                  };
                   4538:                         }
                   4539:                     }
1.490     raeburn  4540:                 }
1.1062    raeburn  4541:             }
                   4542:         }
                   4543:     }
                   4544:     foreach my $blocker (@blockers) {
                   4545:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4546:             &parse_block_record($commblocks{$blocker});
                   4547:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4548:         my ($start,$end,$triggertype);
                   4549:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4550:             ($start,$end) = ($1,$2);
                   4551:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4552:             $start = $triggered{$blocker}{'start'};
                   4553:             $end = $triggered{$blocker}{'end'};
                   4554:             $triggertype = $triggered{$blocker}{'type'};
                   4555:         }
                   4556:         if ($start) {
                   4557:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4558:             if ($triggertype) {
                   4559:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4560:             } else {
                   4561:                 push(@{$$setters{$course}{'triggers'}},0);
                   4562:             }
                   4563:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4564:                 $startblock = $start;
                   4565:                 if ($triggertype) {
                   4566:                     $triggerblock = $blocker;
1.474     raeburn  4567:                 }
                   4568:             }
1.1062    raeburn  4569:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4570:                $endblock = $end;
                   4571:                if ($triggertype) {
                   4572:                    $triggerblock = $blocker;
                   4573:                }
                   4574:             }
1.474     raeburn  4575:         }
                   4576:     }
1.1062    raeburn  4577:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4578: }
                   4579: 
                   4580: sub parse_block_record {
                   4581:     my ($record) = @_;
                   4582:     my ($setuname,$setudom,$title,$blocks);
                   4583:     if (ref($record) eq 'HASH') {
                   4584:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4585:         $title = &unescape($record->{'event'});
                   4586:         $blocks = $record->{'blocks'};
                   4587:     } else {
                   4588:         my @data = split(/:/,$record,3);
                   4589:         if (scalar(@data) eq 2) {
                   4590:             $title = $data[1];
                   4591:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4592:         } else {
                   4593:             ($setuname,$setudom,$title) = @data;
                   4594:         }
                   4595:         $blocks = { 'com' => 'on' };
                   4596:     }
                   4597:     return ($setuname,$setudom,$title,$blocks);
                   4598: }
                   4599: 
1.854     kalberla 4600: sub blocking_status {
1.1062    raeburn  4601:     my ($activity,$uname,$udom,$url) = @_;
1.1061    raeburn  4602:     my %setters;
1.890     droeschl 4603: 
1.1061    raeburn  4604: # check for active blocking
1.1062    raeburn  4605:     my ($startblock,$endblock,$triggerblock) = 
                   4606:         &blockcheck(\%setters,$activity,$uname,$udom,$url);
                   4607:     my $blocked = 0;
                   4608:     if ($startblock && $endblock) {
                   4609:         $blocked = 1;
                   4610:     }
1.890     droeschl 4611: 
1.1061    raeburn  4612: # caller just wants to know whether a block is active
                   4613:     if (!wantarray) { return $blocked; }
                   4614: 
                   4615: # build a link to a popup window containing the details
                   4616:     my $querystring  = "?activity=$activity";
                   4617: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4618:     if ($activity eq 'port') {
                   4619:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4620:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4621:     } elsif ($activity eq 'docs') {
                   4622:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4623:     }
1.1061    raeburn  4624: 
                   4625:     my $output .= <<'END_MYBLOCK';
                   4626: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4627:     var options = "width=" + w + ",height=" + h + ",";
                   4628:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4629:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4630:     var newWin = window.open(url, wdwName, options);
                   4631:     newWin.focus();
                   4632: }
1.890     droeschl 4633: END_MYBLOCK
1.854     kalberla 4634: 
1.1061    raeburn  4635:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4636:   
1.1061    raeburn  4637:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4638:     my $text = &mt('Communication Blocked');
                   4639:     if ($activity eq 'docs') {
                   4640:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4641:     } elsif ($activity eq 'printout') {
                   4642:         $text = &mt('Printing Blocked');
1.1062    raeburn  4643:     }
1.1061    raeburn  4644:     $output .= <<"END_BLOCK";
1.867     kalberla 4645: <div class='LC_comblock'>
1.869     kalberla 4646:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4647:   title='$text'>
                   4648:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4649:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4650:   title='$text'>$text</a>
1.867     kalberla 4651: </div>
                   4652: 
                   4653: END_BLOCK
1.474     raeburn  4654: 
1.1061    raeburn  4655:     return ($blocked, $output);
1.854     kalberla 4656: }
1.490     raeburn  4657: 
1.60      matthew  4658: ###############################################
                   4659: 
1.682     raeburn  4660: sub check_ip_acc {
                   4661:     my ($acc)=@_;
                   4662:     &Apache::lonxml::debug("acc is $acc");
                   4663:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4664:         return 1;
                   4665:     }
                   4666:     my $allowed=0;
                   4667:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4668: 
                   4669:     my $name;
                   4670:     foreach my $pattern (split(',',$acc)) {
                   4671:         $pattern =~ s/^\s*//;
                   4672:         $pattern =~ s/\s*$//;
                   4673:         if ($pattern =~ /\*$/) {
                   4674:             #35.8.*
                   4675:             $pattern=~s/\*//;
                   4676:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4677:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4678:             #35.8.3.[34-56]
                   4679:             my $low=$2;
                   4680:             my $high=$3;
                   4681:             $pattern=$1;
                   4682:             if ($ip =~ /^\Q$pattern\E/) {
                   4683:                 my $last=(split(/\./,$ip))[3];
                   4684:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4685:             }
                   4686:         } elsif ($pattern =~ /^\*/) {
                   4687:             #*.msu.edu
                   4688:             $pattern=~s/\*//;
                   4689:             if (!defined($name)) {
                   4690:                 use Socket;
                   4691:                 my $netaddr=inet_aton($ip);
                   4692:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4693:             }
                   4694:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4695:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4696:             #127.0.0.1
                   4697:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4698:         } else {
                   4699:             #some.name.com
                   4700:             if (!defined($name)) {
                   4701:                 use Socket;
                   4702:                 my $netaddr=inet_aton($ip);
                   4703:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4704:             }
                   4705:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4706:         }
                   4707:         if ($allowed) { last; }
                   4708:     }
                   4709:     return $allowed;
                   4710: }
                   4711: 
                   4712: ###############################################
                   4713: 
1.60      matthew  4714: =pod
                   4715: 
1.112     bowersj2 4716: =head1 Domain Template Functions
                   4717: 
                   4718: =over 4
                   4719: 
                   4720: =item * &determinedomain()
1.60      matthew  4721: 
                   4722: Inputs: $domain (usually will be undef)
                   4723: 
1.63      www      4724: Returns: Determines which domain should be used for designs
1.60      matthew  4725: 
                   4726: =cut
1.54      www      4727: 
1.60      matthew  4728: ###############################################
1.63      www      4729: sub determinedomain {
                   4730:     my $domain=shift;
1.531     albertel 4731:     if (! $domain) {
1.60      matthew  4732:         # Determine domain if we have not been given one
1.893     raeburn  4733:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4734:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4735:         if ($env{'request.role.domain'}) { 
                   4736:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4737:         }
                   4738:     }
1.63      www      4739:     return $domain;
                   4740: }
                   4741: ###############################################
1.517     raeburn  4742: 
1.518     albertel 4743: sub devalidate_domconfig_cache {
                   4744:     my ($udom)=@_;
                   4745:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4746: }
                   4747: 
                   4748: # ---------------------- Get domain configuration for a domain
                   4749: sub get_domainconf {
                   4750:     my ($udom) = @_;
                   4751:     my $cachetime=1800;
                   4752:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4753:     if (defined($cached)) { return %{$result}; }
                   4754: 
                   4755:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4756: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4757:     my (%designhash,%legacy);
1.518     albertel 4758:     if (keys(%domconfig) > 0) {
                   4759:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4760:             if (keys(%{$domconfig{'login'}})) {
                   4761:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4762:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4763:                         if ($key eq 'loginvia') {
                   4764:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4765:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4766:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4767:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4768:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4769:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4770:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4771: 
                   4772:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4773:                                             } else {
1.1013    raeburn  4774:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4775:                                             }
                   4776:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4777:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4778:                                             }
1.946     raeburn  4779:                                         }
                   4780:                                     }
                   4781:                                 }
                   4782:                             }
                   4783:                         } else {
                   4784:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4785:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4786:                                     $domconfig{'login'}{$key}{$img};
                   4787:                             }
1.699     raeburn  4788:                         }
                   4789:                     } else {
                   4790:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4791:                     }
1.632     raeburn  4792:                 }
                   4793:             } else {
                   4794:                 $legacy{'login'} = 1;
1.518     albertel 4795:             }
1.632     raeburn  4796:         } else {
                   4797:             $legacy{'login'} = 1;
1.518     albertel 4798:         }
                   4799:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4800:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4801:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4802:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4803:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4804:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4805:                         }
1.518     albertel 4806:                     }
                   4807:                 }
1.632     raeburn  4808:             } else {
                   4809:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4810:             }
1.632     raeburn  4811:         } else {
                   4812:             $legacy{'rolecolors'} = 1;
1.518     albertel 4813:         }
1.948     raeburn  4814:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4815:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4816:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4817:             }
                   4818:         }
1.632     raeburn  4819:         if (keys(%legacy) > 0) {
                   4820:             my %legacyhash = &get_legacy_domconf($udom);
                   4821:             foreach my $item (keys(%legacyhash)) {
                   4822:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4823:                     if ($legacy{'login'}) { 
                   4824:                         $designhash{$item} = $legacyhash{$item};
                   4825:                     }
                   4826:                 } else {
                   4827:                     if ($legacy{'rolecolors'}) {
                   4828:                         $designhash{$item} = $legacyhash{$item};
                   4829:                     }
1.518     albertel 4830:                 }
                   4831:             }
                   4832:         }
1.632     raeburn  4833:     } else {
                   4834:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4835:     }
                   4836:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4837: 				  $cachetime);
                   4838:     return %designhash;
                   4839: }
                   4840: 
1.632     raeburn  4841: sub get_legacy_domconf {
                   4842:     my ($udom) = @_;
                   4843:     my %legacyhash;
                   4844:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4845:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4846:     if (-e $designfile) {
                   4847:         if ( open (my $fh,"<$designfile") ) {
                   4848:             while (my $line = <$fh>) {
                   4849:                 next if ($line =~ /^\#/);
                   4850:                 chomp($line);
                   4851:                 my ($key,$val)=(split(/\=/,$line));
                   4852:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4853:             }
                   4854:             close($fh);
                   4855:         }
                   4856:     }
1.1026    raeburn  4857:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4858:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4859:     }
                   4860:     return %legacyhash;
                   4861: }
                   4862: 
1.63      www      4863: =pod
                   4864: 
1.112     bowersj2 4865: =item * &domainlogo()
1.63      www      4866: 
                   4867: Inputs: $domain (usually will be undef)
                   4868: 
                   4869: Returns: A link to a domain logo, if the domain logo exists.
                   4870: If the domain logo does not exist, a description of the domain.
                   4871: 
                   4872: =cut
1.112     bowersj2 4873: 
1.63      www      4874: ###############################################
                   4875: sub domainlogo {
1.517     raeburn  4876:     my $domain = &determinedomain(shift);
1.518     albertel 4877:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4878:     # See if there is a logo
                   4879:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4880:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4881:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4882: 	    if ($imgsrc =~ m{^/res/}) {
                   4883: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4884: 		&Apache::lonnet::repcopy($local_name);
                   4885: 	    }
                   4886: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4887:         } 
                   4888:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4889:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4890:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4891:     } else {
1.60      matthew  4892:         return '';
1.59      www      4893:     }
                   4894: }
1.63      www      4895: ##############################################
                   4896: 
                   4897: =pod
                   4898: 
1.112     bowersj2 4899: =item * &designparm()
1.63      www      4900: 
                   4901: Inputs: $which parameter; $domain (usually will be undef)
                   4902: 
                   4903: Returns: value of designparamter $which
                   4904: 
                   4905: =cut
1.112     bowersj2 4906: 
1.397     albertel 4907: 
1.400     albertel 4908: ##############################################
1.397     albertel 4909: sub designparm {
                   4910:     my ($which,$domain)=@_;
                   4911:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4912:         return $env{'environment.color.'.$which};
1.96      www      4913:     }
1.63      www      4914:     $domain=&determinedomain($domain);
1.1016    raeburn  4915:     my %domdesign;
                   4916:     unless ($domain eq 'public') {
                   4917:         %domdesign = &get_domainconf($domain);
                   4918:     }
1.520     raeburn  4919:     my $output;
1.517     raeburn  4920:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4921:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4922:     } else {
1.520     raeburn  4923:         $output = $defaultdesign{$which};
                   4924:     }
                   4925:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4926:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4927:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4928:             if ($output =~ m{^/res/}) {
                   4929:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4930:                 &Apache::lonnet::repcopy($local_name);
                   4931:             }
1.520     raeburn  4932:             $output = &lonhttpdurl($output);
                   4933:         }
1.63      www      4934:     }
1.520     raeburn  4935:     return $output;
1.63      www      4936: }
1.59      www      4937: 
1.822     bisitz   4938: ##############################################
                   4939: =pod
                   4940: 
1.832     bisitz   4941: =item * &authorspace()
                   4942: 
1.1028    raeburn  4943: Inputs: $url (usually will be undef).
1.832     bisitz   4944: 
1.1132    raeburn  4945: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  4946:          directory being viewed (or for which action is being taken). 
                   4947:          If $url is provided, and begins /priv/<domain>/<uname>
                   4948:          the path will be that portion of the $context argument.
                   4949:          Otherwise the path will be for the author space of the current
                   4950:          user when the current role is author, or for that of the 
                   4951:          co-author/assistant co-author space when the current role 
                   4952:          is co-author or assistant co-author.
1.832     bisitz   4953: 
                   4954: =cut
                   4955: 
                   4956: sub authorspace {
1.1028    raeburn  4957:     my ($url) = @_;
                   4958:     if ($url ne '') {
                   4959:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4960:            return $1;
                   4961:         }
                   4962:     }
1.832     bisitz   4963:     my $caname = '';
1.1024    www      4964:     my $cadom = '';
1.1028    raeburn  4965:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4966:         ($cadom,$caname) =
1.832     bisitz   4967:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4968:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4969:         $caname = $env{'user.name'};
1.1024    www      4970:         $cadom = $env{'user.domain'};
1.832     bisitz   4971:     }
1.1028    raeburn  4972:     if (($caname ne '') && ($cadom ne '')) {
                   4973:         return "/priv/$cadom/$caname/";
                   4974:     }
                   4975:     return;
1.832     bisitz   4976: }
                   4977: 
                   4978: ##############################################
                   4979: =pod
                   4980: 
1.822     bisitz   4981: =item * &head_subbox()
                   4982: 
                   4983: Inputs: $content (contains HTML code with page functions, etc.)
                   4984: 
                   4985: Returns: HTML div with $content
                   4986:          To be included in page header
                   4987: 
                   4988: =cut
                   4989: 
                   4990: sub head_subbox {
                   4991:     my ($content)=@_;
                   4992:     my $output =
1.993     raeburn  4993:         '<div class="LC_head_subbox">'
1.822     bisitz   4994:        .$content
                   4995:        .'</div>'
                   4996: }
                   4997: 
                   4998: ##############################################
                   4999: =pod
                   5000: 
                   5001: =item * &CSTR_pageheader()
                   5002: 
1.1026    raeburn  5003: Input: (optional) filename from which breadcrumb trail is built.
                   5004:        In most cases no input as needed, as $env{'request.filename'}
                   5005:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5006: 
                   5007: Returns: HTML div with CSTR path and recent box
1.1132    raeburn  5008:          To be included on Authoring Space pages
1.822     bisitz   5009: 
                   5010: =cut
                   5011: 
                   5012: sub CSTR_pageheader {
1.1026    raeburn  5013:     my ($trailfile) = @_;
                   5014:     if ($trailfile eq '') {
                   5015:         $trailfile = $env{'request.filename'};
                   5016:     }
                   5017: 
                   5018: # this is for resources; directories have customtitle, and crumbs
                   5019: # and select recent are created in lonpubdir.pm
                   5020: 
                   5021:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5022:     my ($udom,$uname,$thisdisfn)=
1.1113    raeburn  5023:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5024:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5025:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5026: 
                   5027:     my $parentpath = '';
                   5028:     my $lastitem = '';
                   5029:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5030:         $parentpath = $1;
                   5031:         $lastitem = $2;
                   5032:     } else {
                   5033:         $lastitem = $thisdisfn;
                   5034:     }
1.921     bisitz   5035: 
                   5036:     my $output =
1.822     bisitz   5037:          '<div>'
                   5038:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132    raeburn  5039:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   5040:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5041:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5042:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5043: 
                   5044:     if ($lastitem) {
                   5045:         $output .=
                   5046:              '<span class="LC_filename">'
                   5047:             .$lastitem
                   5048:             .'</span>';
                   5049:     }
                   5050:     $output .=
                   5051:          '<br />'
1.822     bisitz   5052:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5053:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5054:         .'</form>'
                   5055:         .&Apache::lonmenu::constspaceform()
                   5056:         .'</div>';
1.921     bisitz   5057: 
                   5058:     return $output;
1.822     bisitz   5059: }
                   5060: 
1.60      matthew  5061: ###############################################
                   5062: ###############################################
                   5063: 
                   5064: =pod
                   5065: 
1.112     bowersj2 5066: =back
                   5067: 
1.549     albertel 5068: =head1 HTML Helpers
1.112     bowersj2 5069: 
                   5070: =over 4
                   5071: 
                   5072: =item * &bodytag()
1.60      matthew  5073: 
                   5074: Returns a uniform header for LON-CAPA web pages.
                   5075: 
                   5076: Inputs: 
                   5077: 
1.112     bowersj2 5078: =over 4
                   5079: 
                   5080: =item * $title, A title to be displayed on the page.
                   5081: 
                   5082: =item * $function, the current role (can be undef).
                   5083: 
                   5084: =item * $addentries, extra parameters for the <body> tag.
                   5085: 
                   5086: =item * $bodyonly, if defined, only return the <body> tag.
                   5087: 
                   5088: =item * $domain, if defined, force a given domain.
                   5089: 
                   5090: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5091:             text interface only)
1.60      matthew  5092: 
1.814     bisitz   5093: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5094:                      navigational links
1.317     albertel 5095: 
1.338     albertel 5096: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5097: 
1.460     albertel 5098: =item * $args, optional argument valid values are
                   5099:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5100:             inherit_jsmath -> when creating popup window in a page,
                   5101:                               should it have jsmath forced on by the
                   5102:                               current page
1.460     albertel 5103: 
1.1096    raeburn  5104: =item * $advtoolsref, optional argument, ref to an array containing
                   5105:             inlineremote items to be added in "Functions" menu below
                   5106:             breadcrumbs.
                   5107: 
1.112     bowersj2 5108: =back
                   5109: 
1.60      matthew  5110: Returns: A uniform header for LON-CAPA web pages.  
                   5111: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5112: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5113: other decorations will be returned.
                   5114: 
                   5115: =cut
                   5116: 
1.54      www      5117: sub bodytag {
1.831     bisitz   5118:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096    raeburn  5119:         $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339     albertel 5120: 
1.954     raeburn  5121:     my $public;
                   5122:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5123:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5124:         $public = 1;
                   5125:     }
1.460     albertel 5126:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 5127: 
1.183     matthew  5128:     $function = &get_users_function() if (!$function);
1.339     albertel 5129:     my $img =    &designparm($function.'.img',$domain);
                   5130:     my $font =   &designparm($function.'.font',$domain);
                   5131:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5132: 
1.803     bisitz   5133:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5134: 		   'bgcolor' => $pgbg,
1.339     albertel 5135: 		   'text'    => $font,
                   5136:                    'alink'   => &designparm($function.'.alink',$domain),
                   5137: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5138: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5139:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5140: 
1.63      www      5141:  # role and realm
1.378     raeburn  5142:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   5143:     if ($role  eq 'ca') {
1.479     albertel 5144:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5145:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5146:     } 
1.55      www      5147: # realm
1.258     albertel 5148:     if ($env{'request.course.id'}) {
1.378     raeburn  5149:         if ($env{'request.role'} !~ /^cr/) {
                   5150:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5151:         }
1.898     raeburn  5152:         if ($env{'request.course.sec'}) {
                   5153:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5154:         }   
1.359     albertel 5155: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5156:     } else {
                   5157:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5158:     }
1.433     albertel 5159: 
1.359     albertel 5160:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5161: 
1.438     albertel 5162:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5163: 
1.101     www      5164: # construct main body tag
1.359     albertel 5165:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5166: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5167: 
1.1131    raeburn  5168:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5169: 
1.1130    raeburn  5170:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5171:         return $bodytag;
1.1130    raeburn  5172:     }
1.359     albertel 5173: 
1.954     raeburn  5174:     if ($public) {
1.433     albertel 5175: 	undef($role);
                   5176:     }
1.359     albertel 5177:     
1.762     bisitz   5178:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5179:     #
                   5180:     # Extra info if you are the DC
                   5181:     my $dc_info = '';
                   5182:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5183:                         $env{'course.'.$env{'request.course.id'}.
                   5184:                                  '.domain'}.'/'})) {
                   5185:         my $cid = $env{'request.course.id'};
1.917     raeburn  5186:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5187:         $dc_info =~ s/\s+$//;
1.359     albertel 5188:     }
                   5189: 
1.898     raeburn  5190:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 5191: 
1.903     droeschl 5192:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5193: 
                   5194:         #    if ($env{'request.state'} eq 'construct') {
                   5195:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5196:         #    }
                   5197: 
1.1130    raeburn  5198:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   5199:             Apache::lonmenu::utilityfunctions(), 'start');
1.359     albertel 5200: 
1.1130    raeburn  5201:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.359     albertel 5202: 
1.916     droeschl 5203:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  5204:              if ($dc_info) {
                   5205:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   5206:              }
1.1130    raeburn  5207:              $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916     droeschl 5208:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5209:             return $bodytag;
                   5210:         }
1.894     droeschl 5211: 
1.927     raeburn  5212:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130    raeburn  5213:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5214:         }
1.916     droeschl 5215: 
1.1130    raeburn  5216:         $bodytag .= $right;
1.852     droeschl 5217: 
1.917     raeburn  5218:         if ($dc_info) {
                   5219:             $dc_info = &dc_courseid_toggle($dc_info);
                   5220:         }
                   5221:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5222: 
1.903     droeschl 5223:         #don't show menus for public users
1.954     raeburn  5224:         if (!$public){
1.903     droeschl 5225:             $bodytag .= Apache::lonmenu::secondary_menu();
                   5226:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5227:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5228:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5229:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5230:                                 $args->{'bread_crumbs'});
1.1096    raeburn  5231:             } elsif ($forcereg) {
                   5232:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5233:                                                             $args->{'group'});
                   5234:             } else {
                   5235:                 $bodytag .= 
                   5236:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5237:                                                         $forcereg,$args->{'group'},
                   5238:                                                         $args->{'bread_crumbs'},
                   5239:                                                         $advtoolsref);
1.920     raeburn  5240:             }
1.903     droeschl 5241:         }else{
                   5242:             # this is to seperate menu from content when there's no secondary
                   5243:             # menu. Especially needed for public accessible ressources.
                   5244:             $bodytag .= '<hr style="clear:both" />';
                   5245:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5246:         }
1.903     droeschl 5247: 
1.235     raeburn  5248:         return $bodytag;
1.182     matthew  5249: }
                   5250: 
1.917     raeburn  5251: sub dc_courseid_toggle {
                   5252:     my ($dc_info) = @_;
1.980     raeburn  5253:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5254:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5255:            &mt('(More ...)').'</a></span>'.
                   5256:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5257: }
                   5258: 
1.330     albertel 5259: sub make_attr_string {
                   5260:     my ($register,$attr_ref) = @_;
                   5261: 
                   5262:     if ($attr_ref && !ref($attr_ref)) {
                   5263: 	die("addentries Must be a hash ref ".
                   5264: 	    join(':',caller(1))." ".
                   5265: 	    join(':',caller(0))." ");
                   5266:     }
                   5267: 
                   5268:     if ($register) {
1.339     albertel 5269: 	my ($on_load,$on_unload);
                   5270: 	foreach my $key (keys(%{$attr_ref})) {
                   5271: 	    if      (lc($key) eq 'onload') {
                   5272: 		$on_load.=$attr_ref->{$key}.';';
                   5273: 		delete($attr_ref->{$key});
                   5274: 
                   5275: 	    } elsif (lc($key) eq 'onunload') {
                   5276: 		$on_unload.=$attr_ref->{$key}.';';
                   5277: 		delete($attr_ref->{$key});
                   5278: 	    }
                   5279: 	}
1.953     droeschl 5280: 	$attr_ref->{'onload'}  = $on_load;
                   5281: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 5282:     }
1.339     albertel 5283: 
1.330     albertel 5284:     my $attr_string;
                   5285:     foreach my $attr (keys(%$attr_ref)) {
                   5286: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5287:     }
                   5288:     return $attr_string;
                   5289: }
                   5290: 
                   5291: 
1.182     matthew  5292: ###############################################
1.251     albertel 5293: ###############################################
                   5294: 
                   5295: =pod
                   5296: 
                   5297: =item * &endbodytag()
                   5298: 
                   5299: Returns a uniform footer for LON-CAPA web pages.
                   5300: 
1.635     raeburn  5301: Inputs: 1 - optional reference to an args hash
                   5302: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5303: a 'Continue' link is not displayed if the page contains an
                   5304: internal redirect in the <head></head> section,
                   5305: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5306: 
                   5307: =cut
                   5308: 
                   5309: sub endbodytag {
1.635     raeburn  5310:     my ($args) = @_;
1.1080    raeburn  5311:     my $endbodytag;
                   5312:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5313:         $endbodytag='</body>';
                   5314:     }
1.269     albertel 5315:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5316:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5317:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5318: 	    $endbodytag=
                   5319: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5320: 	        &mt('Continue').'</a>'.
                   5321: 	        $endbodytag;
                   5322:         }
1.315     albertel 5323:     }
1.251     albertel 5324:     return $endbodytag;
                   5325: }
                   5326: 
1.352     albertel 5327: =pod
                   5328: 
                   5329: =item * &standard_css()
                   5330: 
                   5331: Returns a style sheet
                   5332: 
                   5333: Inputs: (all optional)
                   5334:             domain         -> force to color decorate a page for a specific
                   5335:                                domain
                   5336:             function       -> force usage of a specific rolish color scheme
                   5337:             bgcolor        -> override the default page bgcolor
                   5338: 
                   5339: =cut
                   5340: 
1.343     albertel 5341: sub standard_css {
1.345     albertel 5342:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5343:     $function  = &get_users_function() if (!$function);
                   5344:     my $img    = &designparm($function.'.img',   $domain);
                   5345:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5346:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5347:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5348: #second colour for later usage
1.345     albertel 5349:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5350:     my $pgbg_or_bgcolor =
                   5351: 	         $bgcolor ||
1.352     albertel 5352: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5353:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5354:     my $alink  = &designparm($function.'.alink', $domain);
                   5355:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5356:     my $link   = &designparm($function.'.link',  $domain);
                   5357: 
1.602     albertel 5358:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5359:     my $mono                 = 'monospace';
1.850     bisitz   5360:     my $data_table_head      = $sidebg;
                   5361:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5362:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5363:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5364:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5365:     my $mail_new             = '#FFBB77';
                   5366:     my $mail_new_hover       = '#DD9955';
                   5367:     my $mail_read            = '#BBBB77';
                   5368:     my $mail_read_hover      = '#999944';
                   5369:     my $mail_replied         = '#AAAA88';
                   5370:     my $mail_replied_hover   = '#888855';
                   5371:     my $mail_other           = '#99BBBB';
                   5372:     my $mail_other_hover     = '#669999';
1.391     albertel 5373:     my $table_header         = '#DDDDDD';
1.489     raeburn  5374:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5375:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5376:     my $button_hover         = '#BF2317';
1.392     albertel 5377: 
1.608     albertel 5378:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5379:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5380:                                              : '0 3px 0 4px';
1.448     albertel 5381: 
1.523     albertel 5382: 
1.343     albertel 5383:     return <<END;
1.947     droeschl 5384: 
                   5385: /* needed for iframe to allow 100% height in FF */
                   5386: body, html { 
                   5387:     margin: 0;
                   5388:     padding: 0 0.5%;
                   5389:     height: 99%; /* to avoid scrollbars */
                   5390: }
                   5391: 
1.795     www      5392: body {
1.911     bisitz   5393:   font-family: $sans;
                   5394:   line-height:130%;
                   5395:   font-size:0.83em;
                   5396:   color:$font;
1.795     www      5397: }
                   5398: 
1.959     onken    5399: a:focus,
                   5400: a:focus img {
1.795     www      5401:   color: red;
                   5402: }
1.698     harmsja  5403: 
1.911     bisitz   5404: form, .inline {
                   5405:   display: inline;
1.795     www      5406: }
1.721     harmsja  5407: 
1.795     www      5408: .LC_right {
1.911     bisitz   5409:   text-align:right;
1.795     www      5410: }
                   5411: 
                   5412: .LC_middle {
1.911     bisitz   5413:   vertical-align:middle;
1.795     www      5414: }
1.721     harmsja  5415: 
1.1130    raeburn  5416: .LC_floatleft {
                   5417:   float: left;
                   5418: }
                   5419: 
                   5420: .LC_floatright {
                   5421:   float: right;
                   5422: }
                   5423: 
1.911     bisitz   5424: .LC_400Box {
                   5425:   width:400px;
                   5426: }
1.721     harmsja  5427: 
1.947     droeschl 5428: .LC_iframecontainer {
                   5429:     width: 98%;
                   5430:     margin: 0;
                   5431:     position: fixed;
                   5432:     top: 8.5em;
                   5433:     bottom: 0;
                   5434: }
                   5435: 
                   5436: .LC_iframecontainer iframe{
                   5437:     border: none;
                   5438:     width: 100%;
                   5439:     height: 100%;
                   5440: }
                   5441: 
1.778     bisitz   5442: .LC_filename {
                   5443:   font-family: $mono;
                   5444:   white-space:pre;
1.921     bisitz   5445:   font-size: 120%;
1.778     bisitz   5446: }
                   5447: 
                   5448: .LC_fileicon {
                   5449:   border: none;
                   5450:   height: 1.3em;
                   5451:   vertical-align: text-bottom;
                   5452:   margin-right: 0.3em;
                   5453:   text-decoration:none;
                   5454: }
                   5455: 
1.1008    www      5456: .LC_setting {
                   5457:   text-decoration:underline;
                   5458: }
                   5459: 
1.350     albertel 5460: .LC_error {
                   5461:   color: red;
                   5462: }
1.795     www      5463: 
1.1097    bisitz   5464: .LC_warning {
                   5465:   color: darkorange;
                   5466: }
                   5467: 
1.457     albertel 5468: .LC_diff_removed {
1.733     bisitz   5469:   color: red;
1.394     albertel 5470: }
1.532     albertel 5471: 
                   5472: .LC_info,
1.457     albertel 5473: .LC_success,
                   5474: .LC_diff_added {
1.350     albertel 5475:   color: green;
                   5476: }
1.795     www      5477: 
1.802     bisitz   5478: div.LC_confirm_box {
                   5479:   background-color: #FAFAFA;
                   5480:   border: 1px solid $lg_border_color;
                   5481:   margin-right: 0;
                   5482:   padding: 5px;
                   5483: }
                   5484: 
                   5485: div.LC_confirm_box .LC_error img,
                   5486: div.LC_confirm_box .LC_success img {
                   5487:   vertical-align: middle;
                   5488: }
                   5489: 
1.440     albertel 5490: .LC_icon {
1.771     droeschl 5491:   border: none;
1.790     droeschl 5492:   vertical-align: middle;
1.771     droeschl 5493: }
                   5494: 
1.543     albertel 5495: .LC_docs_spacer {
                   5496:   width: 25px;
                   5497:   height: 1px;
1.771     droeschl 5498:   border: none;
1.543     albertel 5499: }
1.346     albertel 5500: 
1.532     albertel 5501: .LC_internal_info {
1.735     bisitz   5502:   color: #999999;
1.532     albertel 5503: }
                   5504: 
1.794     www      5505: .LC_discussion {
1.1050    www      5506:   background: $data_table_dark;
1.911     bisitz   5507:   border: 1px solid black;
                   5508:   margin: 2px;
1.794     www      5509: }
                   5510: 
                   5511: .LC_disc_action_left {
1.1050    www      5512:   background: $sidebg;
1.911     bisitz   5513:   text-align: left;
1.1050    www      5514:   padding: 4px;
                   5515:   margin: 2px;
1.794     www      5516: }
                   5517: 
                   5518: .LC_disc_action_right {
1.1050    www      5519:   background: $sidebg;
1.911     bisitz   5520:   text-align: right;
1.1050    www      5521:   padding: 4px;
                   5522:   margin: 2px;
1.794     www      5523: }
                   5524: 
                   5525: .LC_disc_new_item {
1.911     bisitz   5526:   background: white;
                   5527:   border: 2px solid red;
1.1050    www      5528:   margin: 4px;
                   5529:   padding: 4px;
1.794     www      5530: }
                   5531: 
                   5532: .LC_disc_old_item {
1.911     bisitz   5533:   background: white;
1.1050    www      5534:   margin: 4px;
                   5535:   padding: 4px;
1.794     www      5536: }
                   5537: 
1.458     albertel 5538: table.LC_pastsubmission {
                   5539:   border: 1px solid black;
                   5540:   margin: 2px;
                   5541: }
                   5542: 
1.924     bisitz   5543: table#LC_menubuttons {
1.345     albertel 5544:   width: 100%;
                   5545:   background: $pgbg;
1.392     albertel 5546:   border: 2px;
1.402     albertel 5547:   border-collapse: separate;
1.803     bisitz   5548:   padding: 0;
1.345     albertel 5549: }
1.392     albertel 5550: 
1.801     tempelho 5551: table#LC_title_bar a {
                   5552:   color: $fontmenu;
                   5553: }
1.836     bisitz   5554: 
1.807     droeschl 5555: table#LC_title_bar {
1.819     tempelho 5556:   clear: both;
1.836     bisitz   5557:   display: none;
1.807     droeschl 5558: }
                   5559: 
1.795     www      5560: table#LC_title_bar,
1.933     droeschl 5561: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5562: table#LC_title_bar.LC_with_remote {
1.359     albertel 5563:   width: 100%;
1.392     albertel 5564:   border-color: $pgbg;
                   5565:   border-style: solid;
                   5566:   border-width: $border;
1.379     albertel 5567:   background: $pgbg;
1.801     tempelho 5568:   color: $fontmenu;
1.392     albertel 5569:   border-collapse: collapse;
1.803     bisitz   5570:   padding: 0;
1.819     tempelho 5571:   margin: 0;
1.359     albertel 5572: }
1.795     www      5573: 
1.933     droeschl 5574: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5575:     margin: 0;
                   5576:     padding: 0;
1.933     droeschl 5577:     position: relative;
                   5578:     list-style: none;
1.913     droeschl 5579: }
1.933     droeschl 5580: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5581:     display: inline;
                   5582: }
1.933     droeschl 5583: 
                   5584: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5585:     padding: 0;
1.933     droeschl 5586:     margin: 0;
                   5587:     float: left;
1.913     droeschl 5588: }
1.933     droeschl 5589: .LC_breadcrumb_tools_tools {
                   5590:     padding: 0;
                   5591:     margin: 0;
1.913     droeschl 5592:     float: right;
                   5593: }
                   5594: 
1.359     albertel 5595: table#LC_title_bar td {
                   5596:   background: $tabbg;
                   5597: }
1.795     www      5598: 
1.911     bisitz   5599: table#LC_menubuttons img {
1.803     bisitz   5600:   border: none;
1.346     albertel 5601: }
1.795     www      5602: 
1.842     droeschl 5603: .LC_breadcrumbs_component {
1.911     bisitz   5604:   float: right;
                   5605:   margin: 0 1em;
1.357     albertel 5606: }
1.842     droeschl 5607: .LC_breadcrumbs_component img {
1.911     bisitz   5608:   vertical-align: middle;
1.777     tempelho 5609: }
1.795     www      5610: 
1.383     albertel 5611: td.LC_table_cell_checkbox {
                   5612:   text-align: center;
                   5613: }
1.795     www      5614: 
                   5615: .LC_fontsize_small {
1.911     bisitz   5616:   font-size: 70%;
1.705     tempelho 5617: }
                   5618: 
1.844     bisitz   5619: #LC_breadcrumbs {
1.911     bisitz   5620:   clear:both;
                   5621:   background: $sidebg;
                   5622:   border-bottom: 1px solid $lg_border_color;
                   5623:   line-height: 2.5em;
1.933     droeschl 5624:   overflow: hidden;
1.911     bisitz   5625:   margin: 0;
                   5626:   padding: 0;
1.995     raeburn  5627:   text-align: left;
1.819     tempelho 5628: }
1.862     bisitz   5629: 
1.1098    bisitz   5630: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5631:   clear:both;
                   5632:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5633:   border: 1px solid $sidebg;
1.1098    bisitz   5634:   margin: 0 0 10px 0;
1.966     bisitz   5635:   padding: 3px;
1.995     raeburn  5636:   text-align: left;
1.822     bisitz   5637: }
                   5638: 
1.795     www      5639: .LC_fontsize_medium {
1.911     bisitz   5640:   font-size: 85%;
1.705     tempelho 5641: }
                   5642: 
1.795     www      5643: .LC_fontsize_large {
1.911     bisitz   5644:   font-size: 120%;
1.705     tempelho 5645: }
                   5646: 
1.346     albertel 5647: .LC_menubuttons_inline_text {
                   5648:   color: $font;
1.698     harmsja  5649:   font-size: 90%;
1.701     harmsja  5650:   padding-left:3px;
1.346     albertel 5651: }
                   5652: 
1.934     droeschl 5653: .LC_menubuttons_inline_text img{
                   5654:   vertical-align: middle;
                   5655: }
                   5656: 
1.1051    www      5657: li.LC_menubuttons_inline_text img {
1.951     onken    5658:   cursor:pointer;
1.1002    droeschl 5659:   text-decoration: none;
1.951     onken    5660: }
                   5661: 
1.526     www      5662: .LC_menubuttons_link {
                   5663:   text-decoration: none;
                   5664: }
1.795     www      5665: 
1.522     albertel 5666: .LC_menubuttons_category {
1.521     www      5667:   color: $font;
1.526     www      5668:   background: $pgbg;
1.521     www      5669:   font-size: larger;
                   5670:   font-weight: bold;
                   5671: }
                   5672: 
1.346     albertel 5673: td.LC_menubuttons_text {
1.911     bisitz   5674:   color: $font;
1.346     albertel 5675: }
1.706     harmsja  5676: 
1.346     albertel 5677: .LC_current_location {
                   5678:   background: $tabbg;
                   5679: }
1.795     www      5680: 
1.938     bisitz   5681: table.LC_data_table {
1.347     albertel 5682:   border: 1px solid #000000;
1.402     albertel 5683:   border-collapse: separate;
1.426     albertel 5684:   border-spacing: 1px;
1.610     albertel 5685:   background: $pgbg;
1.347     albertel 5686: }
1.795     www      5687: 
1.422     albertel 5688: .LC_data_table_dense {
                   5689:   font-size: small;
                   5690: }
1.795     www      5691: 
1.507     raeburn  5692: table.LC_nested_outer {
                   5693:   border: 1px solid #000000;
1.589     raeburn  5694:   border-collapse: collapse;
1.803     bisitz   5695:   border-spacing: 0;
1.507     raeburn  5696:   width: 100%;
                   5697: }
1.795     www      5698: 
1.879     raeburn  5699: table.LC_innerpickbox,
1.507     raeburn  5700: table.LC_nested {
1.803     bisitz   5701:   border: none;
1.589     raeburn  5702:   border-collapse: collapse;
1.803     bisitz   5703:   border-spacing: 0;
1.507     raeburn  5704:   width: 100%;
                   5705: }
1.795     www      5706: 
1.911     bisitz   5707: table.LC_data_table tr th,
                   5708: table.LC_calendar tr th,
1.879     raeburn  5709: table.LC_prior_tries tr th,
                   5710: table.LC_innerpickbox tr th {
1.349     albertel 5711:   font-weight: bold;
                   5712:   background-color: $data_table_head;
1.801     tempelho 5713:   color:$fontmenu;
1.701     harmsja  5714:   font-size:90%;
1.347     albertel 5715: }
1.795     www      5716: 
1.879     raeburn  5717: table.LC_innerpickbox tr th,
                   5718: table.LC_innerpickbox tr td {
                   5719:   vertical-align: top;
                   5720: }
                   5721: 
1.711     raeburn  5722: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5723:   background-color: #CCCCCC;
1.711     raeburn  5724:   font-weight: bold;
                   5725:   text-align: left;
                   5726: }
1.795     www      5727: 
1.912     bisitz   5728: table.LC_data_table tr.LC_odd_row > td {
                   5729:   background-color: $data_table_light;
                   5730:   padding: 2px;
                   5731:   vertical-align: top;
                   5732: }
                   5733: 
1.809     bisitz   5734: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5735:   background-color: $data_table_light;
1.912     bisitz   5736:   vertical-align: top;
                   5737: }
                   5738: 
                   5739: table.LC_data_table tr.LC_even_row > td {
                   5740:   background-color: $data_table_dark;
1.425     albertel 5741:   padding: 2px;
1.900     bisitz   5742:   vertical-align: top;
1.347     albertel 5743: }
1.795     www      5744: 
1.809     bisitz   5745: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5746:   background-color: $data_table_dark;
1.900     bisitz   5747:   vertical-align: top;
1.347     albertel 5748: }
1.795     www      5749: 
1.425     albertel 5750: table.LC_data_table tr.LC_data_table_highlight td {
                   5751:   background-color: $data_table_darker;
                   5752: }
1.795     www      5753: 
1.639     raeburn  5754: table.LC_data_table tr td.LC_leftcol_header {
                   5755:   background-color: $data_table_head;
                   5756:   font-weight: bold;
                   5757: }
1.795     www      5758: 
1.451     albertel 5759: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5760: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5761:   font-weight: bold;
                   5762:   font-style: italic;
                   5763:   text-align: center;
                   5764:   padding: 8px;
1.347     albertel 5765: }
1.795     www      5766: 
1.1114    raeburn  5767: table.LC_data_table tr.LC_empty_row td,
                   5768: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   5769:   background-color: $sidebg;
                   5770: }
                   5771: 
                   5772: table.LC_nested tr.LC_empty_row td {
                   5773:   background-color: #FFFFFF;
                   5774: }
                   5775: 
1.890     droeschl 5776: table.LC_caption {
                   5777: }
                   5778: 
1.507     raeburn  5779: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5780:   padding: 4ex
                   5781: }
1.795     www      5782: 
1.507     raeburn  5783: table.LC_nested_outer tr th {
                   5784:   font-weight: bold;
1.801     tempelho 5785:   color:$fontmenu;
1.507     raeburn  5786:   background-color: $data_table_head;
1.701     harmsja  5787:   font-size: small;
1.507     raeburn  5788:   border-bottom: 1px solid #000000;
                   5789: }
1.795     www      5790: 
1.507     raeburn  5791: table.LC_nested_outer tr td.LC_subheader {
                   5792:   background-color: $data_table_head;
                   5793:   font-weight: bold;
                   5794:   font-size: small;
                   5795:   border-bottom: 1px solid #000000;
                   5796:   text-align: right;
1.451     albertel 5797: }
1.795     www      5798: 
1.507     raeburn  5799: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5800:   background-color: #CCCCCC;
1.451     albertel 5801:   font-weight: bold;
                   5802:   font-size: small;
1.507     raeburn  5803:   text-align: center;
                   5804: }
1.795     www      5805: 
1.589     raeburn  5806: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5807: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5808:   text-align: left;
1.451     albertel 5809: }
1.795     www      5810: 
1.507     raeburn  5811: table.LC_nested td {
1.735     bisitz   5812:   background-color: #FFFFFF;
1.451     albertel 5813:   font-size: small;
1.507     raeburn  5814: }
1.795     www      5815: 
1.507     raeburn  5816: table.LC_nested_outer tr th.LC_right_item,
                   5817: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5818: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5819: table.LC_nested tr td.LC_right_item {
1.451     albertel 5820:   text-align: right;
                   5821: }
                   5822: 
1.507     raeburn  5823: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5824:   background-color: #EEEEEE;
1.451     albertel 5825: }
                   5826: 
1.473     raeburn  5827: table.LC_createuser {
                   5828: }
                   5829: 
                   5830: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5831:   font-size: small;
1.473     raeburn  5832: }
                   5833: 
                   5834: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5835:   background-color: #CCCCCC;
1.473     raeburn  5836:   font-weight: bold;
                   5837:   text-align: center;
                   5838: }
                   5839: 
1.349     albertel 5840: table.LC_calendar {
                   5841:   border: 1px solid #000000;
                   5842:   border-collapse: collapse;
1.917     raeburn  5843:   width: 98%;
1.349     albertel 5844: }
1.795     www      5845: 
1.349     albertel 5846: table.LC_calendar_pickdate {
                   5847:   font-size: xx-small;
                   5848: }
1.795     www      5849: 
1.349     albertel 5850: table.LC_calendar tr td {
                   5851:   border: 1px solid #000000;
                   5852:   vertical-align: top;
1.917     raeburn  5853:   width: 14%;
1.349     albertel 5854: }
1.795     www      5855: 
1.349     albertel 5856: table.LC_calendar tr td.LC_calendar_day_empty {
                   5857:   background-color: $data_table_dark;
                   5858: }
1.795     www      5859: 
1.779     bisitz   5860: table.LC_calendar tr td.LC_calendar_day_current {
                   5861:   background-color: $data_table_highlight;
1.777     tempelho 5862: }
1.795     www      5863: 
1.938     bisitz   5864: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5865:   background-color: $mail_new;
                   5866: }
1.795     www      5867: 
1.938     bisitz   5868: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5869:   background-color: $mail_new_hover;
                   5870: }
1.795     www      5871: 
1.938     bisitz   5872: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5873:   background-color: $mail_read;
                   5874: }
1.795     www      5875: 
1.938     bisitz   5876: /*
                   5877: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5878:   background-color: $mail_read_hover;
                   5879: }
1.938     bisitz   5880: */
1.795     www      5881: 
1.938     bisitz   5882: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5883:   background-color: $mail_replied;
                   5884: }
1.795     www      5885: 
1.938     bisitz   5886: /*
                   5887: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5888:   background-color: $mail_replied_hover;
                   5889: }
1.938     bisitz   5890: */
1.795     www      5891: 
1.938     bisitz   5892: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5893:   background-color: $mail_other;
                   5894: }
1.795     www      5895: 
1.938     bisitz   5896: /*
                   5897: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5898:   background-color: $mail_other_hover;
                   5899: }
1.938     bisitz   5900: */
1.494     raeburn  5901: 
1.777     tempelho 5902: table.LC_data_table tr > td.LC_browser_file,
                   5903: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5904:   background: #AAEE77;
1.389     albertel 5905: }
1.795     www      5906: 
1.777     tempelho 5907: table.LC_data_table tr > td.LC_browser_file_locked,
                   5908: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5909:   background: #FFAA99;
1.387     albertel 5910: }
1.795     www      5911: 
1.777     tempelho 5912: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5913:   background: #888888;
1.779     bisitz   5914: }
1.795     www      5915: 
1.777     tempelho 5916: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5917: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5918:   background: #F8F866;
1.777     tempelho 5919: }
1.795     www      5920: 
1.696     bisitz   5921: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5922:   background: #E0E8FF;
1.387     albertel 5923: }
1.696     bisitz   5924: 
1.707     bisitz   5925: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5926:   /* background: #77FF77; */
1.707     bisitz   5927: }
1.795     www      5928: 
1.707     bisitz   5929: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5930:   border-right: 8px solid #FFFF77;
1.707     bisitz   5931: }
1.795     www      5932: 
1.707     bisitz   5933: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5934:   border-right: 8px solid #FFAA77;
1.707     bisitz   5935: }
1.795     www      5936: 
1.707     bisitz   5937: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5938:   border-right: 8px solid #FF7777;
1.707     bisitz   5939: }
1.795     www      5940: 
1.707     bisitz   5941: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5942:   border-right: 8px solid #AAFF77;
1.707     bisitz   5943: }
1.795     www      5944: 
1.707     bisitz   5945: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5946:   border-right: 8px solid #11CC55;
1.707     bisitz   5947: }
                   5948: 
1.388     albertel 5949: span.LC_current_location {
1.701     harmsja  5950:   font-size:larger;
1.388     albertel 5951:   background: $pgbg;
                   5952: }
1.387     albertel 5953: 
1.1029    www      5954: span.LC_current_nav_location {
                   5955:   font-weight:bold;
                   5956:   background: $sidebg;
                   5957: }
                   5958: 
1.395     albertel 5959: span.LC_parm_menu_item {
                   5960:   font-size: larger;
                   5961: }
1.795     www      5962: 
1.395     albertel 5963: span.LC_parm_scope_all {
                   5964:   color: red;
                   5965: }
1.795     www      5966: 
1.395     albertel 5967: span.LC_parm_scope_folder {
                   5968:   color: green;
                   5969: }
1.795     www      5970: 
1.395     albertel 5971: span.LC_parm_scope_resource {
                   5972:   color: orange;
                   5973: }
1.795     www      5974: 
1.395     albertel 5975: span.LC_parm_part {
                   5976:   color: blue;
                   5977: }
1.795     www      5978: 
1.911     bisitz   5979: span.LC_parm_folder,
                   5980: span.LC_parm_symb {
1.395     albertel 5981:   font-size: x-small;
                   5982:   font-family: $mono;
                   5983:   color: #AAAAAA;
                   5984: }
                   5985: 
1.977     bisitz   5986: ul.LC_parm_parmlist li {
                   5987:   display: inline-block;
                   5988:   padding: 0.3em 0.8em;
                   5989:   vertical-align: top;
                   5990:   width: 150px;
                   5991:   border-top:1px solid $lg_border_color;
                   5992: }
                   5993: 
1.795     www      5994: td.LC_parm_overview_level_menu,
                   5995: td.LC_parm_overview_map_menu,
                   5996: td.LC_parm_overview_parm_selectors,
                   5997: td.LC_parm_overview_restrictions  {
1.396     albertel 5998:   border: 1px solid black;
                   5999:   border-collapse: collapse;
                   6000: }
1.795     www      6001: 
1.396     albertel 6002: table.LC_parm_overview_restrictions td {
                   6003:   border-width: 1px 4px 1px 4px;
                   6004:   border-style: solid;
                   6005:   border-color: $pgbg;
                   6006:   text-align: center;
                   6007: }
1.795     www      6008: 
1.396     albertel 6009: table.LC_parm_overview_restrictions th {
                   6010:   background: $tabbg;
                   6011:   border-width: 1px 4px 1px 4px;
                   6012:   border-style: solid;
                   6013:   border-color: $pgbg;
                   6014: }
1.795     www      6015: 
1.398     albertel 6016: table#LC_helpmenu {
1.803     bisitz   6017:   border: none;
1.398     albertel 6018:   height: 55px;
1.803     bisitz   6019:   border-spacing: 0;
1.398     albertel 6020: }
                   6021: 
                   6022: table#LC_helpmenu fieldset legend {
                   6023:   font-size: larger;
                   6024: }
1.795     www      6025: 
1.397     albertel 6026: table#LC_helpmenu_links {
                   6027:   width: 100%;
                   6028:   border: 1px solid black;
                   6029:   background: $pgbg;
1.803     bisitz   6030:   padding: 0;
1.397     albertel 6031:   border-spacing: 1px;
                   6032: }
1.795     www      6033: 
1.397     albertel 6034: table#LC_helpmenu_links tr td {
                   6035:   padding: 1px;
                   6036:   background: $tabbg;
1.399     albertel 6037:   text-align: center;
                   6038:   font-weight: bold;
1.397     albertel 6039: }
1.396     albertel 6040: 
1.795     www      6041: table#LC_helpmenu_links a:link,
                   6042: table#LC_helpmenu_links a:visited,
1.397     albertel 6043: table#LC_helpmenu_links a:active {
                   6044:   text-decoration: none;
                   6045:   color: $font;
                   6046: }
1.795     www      6047: 
1.397     albertel 6048: table#LC_helpmenu_links a:hover {
                   6049:   text-decoration: underline;
                   6050:   color: $vlink;
                   6051: }
1.396     albertel 6052: 
1.417     albertel 6053: .LC_chrt_popup_exists {
                   6054:   border: 1px solid #339933;
                   6055:   margin: -1px;
                   6056: }
1.795     www      6057: 
1.417     albertel 6058: .LC_chrt_popup_up {
                   6059:   border: 1px solid yellow;
                   6060:   margin: -1px;
                   6061: }
1.795     www      6062: 
1.417     albertel 6063: .LC_chrt_popup {
                   6064:   border: 1px solid #8888FF;
                   6065:   background: #CCCCFF;
                   6066: }
1.795     www      6067: 
1.421     albertel 6068: table.LC_pick_box {
                   6069:   border-collapse: separate;
                   6070:   background: white;
                   6071:   border: 1px solid black;
                   6072:   border-spacing: 1px;
                   6073: }
1.795     www      6074: 
1.421     albertel 6075: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6076:   background: $sidebg;
1.421     albertel 6077:   font-weight: bold;
1.900     bisitz   6078:   text-align: left;
1.740     bisitz   6079:   vertical-align: top;
1.421     albertel 6080:   width: 184px;
                   6081:   padding: 8px;
                   6082: }
1.795     www      6083: 
1.579     raeburn  6084: table.LC_pick_box td.LC_pick_box_value {
                   6085:   text-align: left;
                   6086:   padding: 8px;
                   6087: }
1.795     www      6088: 
1.579     raeburn  6089: table.LC_pick_box td.LC_pick_box_select {
                   6090:   text-align: left;
                   6091:   padding: 8px;
                   6092: }
1.795     www      6093: 
1.424     albertel 6094: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6095:   padding: 0;
1.421     albertel 6096:   height: 1px;
                   6097:   background: black;
                   6098: }
1.795     www      6099: 
1.421     albertel 6100: table.LC_pick_box td.LC_pick_box_submit {
                   6101:   text-align: right;
                   6102: }
1.795     www      6103: 
1.579     raeburn  6104: table.LC_pick_box td.LC_evenrow_value {
                   6105:   text-align: left;
                   6106:   padding: 8px;
                   6107:   background-color: $data_table_light;
                   6108: }
1.795     www      6109: 
1.579     raeburn  6110: table.LC_pick_box td.LC_oddrow_value {
                   6111:   text-align: left;
                   6112:   padding: 8px;
                   6113:   background-color: $data_table_light;
                   6114: }
1.795     www      6115: 
1.579     raeburn  6116: span.LC_helpform_receipt_cat {
                   6117:   font-weight: bold;
                   6118: }
1.795     www      6119: 
1.424     albertel 6120: table.LC_group_priv_box {
                   6121:   background: white;
                   6122:   border: 1px solid black;
                   6123:   border-spacing: 1px;
                   6124: }
1.795     www      6125: 
1.424     albertel 6126: table.LC_group_priv_box td.LC_pick_box_title {
                   6127:   background: $tabbg;
                   6128:   font-weight: bold;
                   6129:   text-align: right;
                   6130:   width: 184px;
                   6131: }
1.795     www      6132: 
1.424     albertel 6133: table.LC_group_priv_box td.LC_groups_fixed {
                   6134:   background: $data_table_light;
                   6135:   text-align: center;
                   6136: }
1.795     www      6137: 
1.424     albertel 6138: table.LC_group_priv_box td.LC_groups_optional {
                   6139:   background: $data_table_dark;
                   6140:   text-align: center;
                   6141: }
1.795     www      6142: 
1.424     albertel 6143: table.LC_group_priv_box td.LC_groups_functionality {
                   6144:   background: $data_table_darker;
                   6145:   text-align: center;
                   6146:   font-weight: bold;
                   6147: }
1.795     www      6148: 
1.424     albertel 6149: table.LC_group_priv td {
                   6150:   text-align: left;
1.803     bisitz   6151:   padding: 0;
1.424     albertel 6152: }
                   6153: 
                   6154: .LC_navbuttons {
                   6155:   margin: 2ex 0ex 2ex 0ex;
                   6156: }
1.795     www      6157: 
1.423     albertel 6158: .LC_topic_bar {
                   6159:   font-weight: bold;
                   6160:   background: $tabbg;
1.918     wenzelju 6161:   margin: 1em 0em 1em 2em;
1.805     bisitz   6162:   padding: 3px;
1.918     wenzelju 6163:   font-size: 1.2em;
1.423     albertel 6164: }
1.795     www      6165: 
1.423     albertel 6166: .LC_topic_bar span {
1.918     wenzelju 6167:   left: 0.5em;
                   6168:   position: absolute;
1.423     albertel 6169:   vertical-align: middle;
1.918     wenzelju 6170:   font-size: 1.2em;
1.423     albertel 6171: }
1.795     www      6172: 
1.423     albertel 6173: table.LC_course_group_status {
                   6174:   margin: 20px;
                   6175: }
1.795     www      6176: 
1.423     albertel 6177: table.LC_status_selector td {
                   6178:   vertical-align: top;
                   6179:   text-align: center;
1.424     albertel 6180:   padding: 4px;
                   6181: }
1.795     www      6182: 
1.599     albertel 6183: div.LC_feedback_link {
1.616     albertel 6184:   clear: both;
1.829     kalberla 6185:   background: $sidebg;
1.779     bisitz   6186:   width: 100%;
1.829     kalberla 6187:   padding-bottom: 10px;
                   6188:   border: 1px $tabbg solid;
1.833     kalberla 6189:   height: 22px;
                   6190:   line-height: 22px;
                   6191:   padding-top: 5px;
                   6192: }
                   6193: 
                   6194: div.LC_feedback_link img {
                   6195:   height: 22px;
1.867     kalberla 6196:   vertical-align:middle;
1.829     kalberla 6197: }
                   6198: 
1.911     bisitz   6199: div.LC_feedback_link a {
1.829     kalberla 6200:   text-decoration: none;
1.489     raeburn  6201: }
1.795     www      6202: 
1.867     kalberla 6203: div.LC_comblock {
1.911     bisitz   6204:   display:inline;
1.867     kalberla 6205:   color:$font;
                   6206:   font-size:90%;
                   6207: }
                   6208: 
                   6209: div.LC_feedback_link div.LC_comblock {
                   6210:   padding-left:5px;
                   6211: }
                   6212: 
                   6213: div.LC_feedback_link div.LC_comblock a {
                   6214:   color:$font;
                   6215: }
                   6216: 
1.489     raeburn  6217: span.LC_feedback_link {
1.858     bisitz   6218:   /* background: $feedback_link_bg; */
1.599     albertel 6219:   font-size: larger;
                   6220: }
1.795     www      6221: 
1.599     albertel 6222: span.LC_message_link {
1.858     bisitz   6223:   /* background: $feedback_link_bg; */
1.599     albertel 6224:   font-size: larger;
                   6225:   position: absolute;
                   6226:   right: 1em;
1.489     raeburn  6227: }
1.421     albertel 6228: 
1.515     albertel 6229: table.LC_prior_tries {
1.524     albertel 6230:   border: 1px solid #000000;
                   6231:   border-collapse: separate;
                   6232:   border-spacing: 1px;
1.515     albertel 6233: }
1.523     albertel 6234: 
1.515     albertel 6235: table.LC_prior_tries td {
1.524     albertel 6236:   padding: 2px;
1.515     albertel 6237: }
1.523     albertel 6238: 
                   6239: .LC_answer_correct {
1.795     www      6240:   background: lightgreen;
                   6241:   color: darkgreen;
                   6242:   padding: 6px;
1.523     albertel 6243: }
1.795     www      6244: 
1.523     albertel 6245: .LC_answer_charged_try {
1.797     www      6246:   background: #FFAAAA;
1.795     www      6247:   color: darkred;
                   6248:   padding: 6px;
1.523     albertel 6249: }
1.795     www      6250: 
1.779     bisitz   6251: .LC_answer_not_charged_try,
1.523     albertel 6252: .LC_answer_no_grade,
                   6253: .LC_answer_late {
1.795     www      6254:   background: lightyellow;
1.523     albertel 6255:   color: black;
1.795     www      6256:   padding: 6px;
1.523     albertel 6257: }
1.795     www      6258: 
1.523     albertel 6259: .LC_answer_previous {
1.795     www      6260:   background: lightblue;
                   6261:   color: darkblue;
                   6262:   padding: 6px;
1.523     albertel 6263: }
1.795     www      6264: 
1.779     bisitz   6265: .LC_answer_no_message {
1.777     tempelho 6266:   background: #FFFFFF;
                   6267:   color: black;
1.795     www      6268:   padding: 6px;
1.779     bisitz   6269: }
1.795     www      6270: 
1.779     bisitz   6271: .LC_answer_unknown {
                   6272:   background: orange;
                   6273:   color: black;
1.795     www      6274:   padding: 6px;
1.777     tempelho 6275: }
1.795     www      6276: 
1.529     albertel 6277: span.LC_prior_numerical,
                   6278: span.LC_prior_string,
                   6279: span.LC_prior_custom,
                   6280: span.LC_prior_reaction,
                   6281: span.LC_prior_math {
1.925     bisitz   6282:   font-family: $mono;
1.523     albertel 6283:   white-space: pre;
                   6284: }
                   6285: 
1.525     albertel 6286: span.LC_prior_string {
1.925     bisitz   6287:   font-family: $mono;
1.525     albertel 6288:   white-space: pre;
                   6289: }
                   6290: 
1.523     albertel 6291: table.LC_prior_option {
                   6292:   width: 100%;
                   6293:   border-collapse: collapse;
                   6294: }
1.795     www      6295: 
1.911     bisitz   6296: table.LC_prior_rank,
1.795     www      6297: table.LC_prior_match {
1.528     albertel 6298:   border-collapse: collapse;
                   6299: }
1.795     www      6300: 
1.528     albertel 6301: table.LC_prior_option tr td,
                   6302: table.LC_prior_rank tr td,
                   6303: table.LC_prior_match tr td {
1.524     albertel 6304:   border: 1px solid #000000;
1.515     albertel 6305: }
                   6306: 
1.855     bisitz   6307: .LC_nobreak {
1.544     albertel 6308:   white-space: nowrap;
1.519     raeburn  6309: }
                   6310: 
1.576     raeburn  6311: span.LC_cusr_emph {
                   6312:   font-style: italic;
                   6313: }
                   6314: 
1.633     raeburn  6315: span.LC_cusr_subheading {
                   6316:   font-weight: normal;
                   6317:   font-size: 85%;
                   6318: }
                   6319: 
1.861     bisitz   6320: div.LC_docs_entry_move {
1.859     bisitz   6321:   border: 1px solid #BBBBBB;
1.545     albertel 6322:   background: #DDDDDD;
1.861     bisitz   6323:   width: 22px;
1.859     bisitz   6324:   padding: 1px;
                   6325:   margin: 0;
1.545     albertel 6326: }
                   6327: 
1.861     bisitz   6328: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6329: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6330:   font-size: x-small;
                   6331: }
1.795     www      6332: 
1.861     bisitz   6333: .LC_docs_entry_parameter {
                   6334:   white-space: nowrap;
                   6335: }
                   6336: 
1.544     albertel 6337: .LC_docs_copy {
1.545     albertel 6338:   color: #000099;
1.544     albertel 6339: }
1.795     www      6340: 
1.544     albertel 6341: .LC_docs_cut {
1.545     albertel 6342:   color: #550044;
1.544     albertel 6343: }
1.795     www      6344: 
1.544     albertel 6345: .LC_docs_rename {
1.545     albertel 6346:   color: #009900;
1.544     albertel 6347: }
1.795     www      6348: 
1.544     albertel 6349: .LC_docs_remove {
1.545     albertel 6350:   color: #990000;
                   6351: }
                   6352: 
1.547     albertel 6353: .LC_docs_reinit_warn,
                   6354: .LC_docs_ext_edit {
                   6355:   font-size: x-small;
                   6356: }
                   6357: 
1.545     albertel 6358: table.LC_docs_adddocs td,
                   6359: table.LC_docs_adddocs th {
                   6360:   border: 1px solid #BBBBBB;
                   6361:   padding: 4px;
                   6362:   background: #DDDDDD;
1.543     albertel 6363: }
                   6364: 
1.584     albertel 6365: table.LC_sty_begin {
                   6366:   background: #BBFFBB;
                   6367: }
1.795     www      6368: 
1.584     albertel 6369: table.LC_sty_end {
                   6370:   background: #FFBBBB;
                   6371: }
                   6372: 
1.589     raeburn  6373: table.LC_double_column {
1.803     bisitz   6374:   border-width: 0;
1.589     raeburn  6375:   border-collapse: collapse;
                   6376:   width: 100%;
                   6377:   padding: 2px;
                   6378: }
                   6379: 
                   6380: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6381:   top: 2px;
1.589     raeburn  6382:   left: 2px;
                   6383:   width: 47%;
                   6384:   vertical-align: top;
                   6385: }
                   6386: 
                   6387: table.LC_double_column tr td.LC_right_col {
                   6388:   top: 2px;
1.779     bisitz   6389:   right: 2px;
1.589     raeburn  6390:   width: 47%;
                   6391:   vertical-align: top;
                   6392: }
                   6393: 
1.591     raeburn  6394: div.LC_left_float {
                   6395:   float: left;
                   6396:   padding-right: 5%;
1.597     albertel 6397:   padding-bottom: 4px;
1.591     raeburn  6398: }
                   6399: 
                   6400: div.LC_clear_float_header {
1.597     albertel 6401:   padding-bottom: 2px;
1.591     raeburn  6402: }
                   6403: 
                   6404: div.LC_clear_float_footer {
1.597     albertel 6405:   padding-top: 10px;
1.591     raeburn  6406:   clear: both;
                   6407: }
                   6408: 
1.597     albertel 6409: div.LC_grade_show_user {
1.941     bisitz   6410: /*  border-left: 5px solid $sidebg; */
                   6411:   border-top: 5px solid #000000;
                   6412:   margin: 50px 0 0 0;
1.936     bisitz   6413:   padding: 15px 0 5px 10px;
1.597     albertel 6414: }
1.795     www      6415: 
1.936     bisitz   6416: div.LC_grade_show_user_odd_row {
1.941     bisitz   6417: /*  border-left: 5px solid #000000; */
                   6418: }
                   6419: 
                   6420: div.LC_grade_show_user div.LC_Box {
                   6421:   margin-right: 50px;
1.597     albertel 6422: }
                   6423: 
                   6424: div.LC_grade_submissions,
                   6425: div.LC_grade_message_center,
1.936     bisitz   6426: div.LC_grade_info_links {
1.597     albertel 6427:   margin: 5px;
                   6428:   width: 99%;
                   6429:   background: #FFFFFF;
                   6430: }
1.795     www      6431: 
1.597     albertel 6432: div.LC_grade_submissions_header,
1.936     bisitz   6433: div.LC_grade_message_center_header {
1.705     tempelho 6434:   font-weight: bold;
                   6435:   font-size: large;
1.597     albertel 6436: }
1.795     www      6437: 
1.597     albertel 6438: div.LC_grade_submissions_body,
1.936     bisitz   6439: div.LC_grade_message_center_body {
1.597     albertel 6440:   border: 1px solid black;
                   6441:   width: 99%;
                   6442:   background: #FFFFFF;
                   6443: }
1.795     www      6444: 
1.613     albertel 6445: table.LC_scantron_action {
                   6446:   width: 100%;
                   6447: }
1.795     www      6448: 
1.613     albertel 6449: table.LC_scantron_action tr th {
1.698     harmsja  6450:   font-weight:bold;
                   6451:   font-style:normal;
1.613     albertel 6452: }
1.795     www      6453: 
1.779     bisitz   6454: .LC_edit_problem_header,
1.614     albertel 6455: div.LC_edit_problem_footer {
1.705     tempelho 6456:   font-weight: normal;
                   6457:   font-size:  medium;
1.602     albertel 6458:   margin: 2px;
1.1060    bisitz   6459:   background-color: $sidebg;
1.600     albertel 6460: }
1.795     www      6461: 
1.600     albertel 6462: div.LC_edit_problem_header,
1.602     albertel 6463: div.LC_edit_problem_header div,
1.614     albertel 6464: div.LC_edit_problem_footer,
                   6465: div.LC_edit_problem_footer div,
1.602     albertel 6466: div.LC_edit_problem_editxml_header,
                   6467: div.LC_edit_problem_editxml_header div {
1.600     albertel 6468:   margin-top: 5px;
                   6469: }
1.795     www      6470: 
1.600     albertel 6471: div.LC_edit_problem_header_title {
1.705     tempelho 6472:   font-weight: bold;
                   6473:   font-size: larger;
1.602     albertel 6474:   background: $tabbg;
                   6475:   padding: 3px;
1.1060    bisitz   6476:   margin: 0 0 5px 0;
1.602     albertel 6477: }
1.795     www      6478: 
1.602     albertel 6479: table.LC_edit_problem_header_title {
                   6480:   width: 100%;
1.600     albertel 6481:   background: $tabbg;
1.602     albertel 6482: }
                   6483: 
                   6484: div.LC_edit_problem_discards {
                   6485:   float: left;
                   6486:   padding-bottom: 5px;
                   6487: }
1.795     www      6488: 
1.602     albertel 6489: div.LC_edit_problem_saves {
                   6490:   float: right;
                   6491:   padding-bottom: 5px;
1.600     albertel 6492: }
1.795     www      6493: 
1.1124    bisitz   6494: .LC_edit_opt {
                   6495:   padding-left: 1em;
                   6496:   white-space: nowrap;
                   6497: }
                   6498: 
1.911     bisitz   6499: img.stift {
1.803     bisitz   6500:   border-width: 0;
                   6501:   vertical-align: middle;
1.677     riegler  6502: }
1.680     riegler  6503: 
1.923     bisitz   6504: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6505:   vertical-align: top;
1.777     tempelho 6506: }
1.795     www      6507: 
1.716     raeburn  6508: div.LC_createcourse {
1.911     bisitz   6509:   margin: 10px 10px 10px 10px;
1.716     raeburn  6510: }
                   6511: 
1.917     raeburn  6512: .LC_dccid {
1.1130    raeburn  6513:   float: right;
1.917     raeburn  6514:   margin: 0.2em 0 0 0;
                   6515:   padding: 0;
                   6516:   font-size: 90%;
                   6517:   display:none;
                   6518: }
                   6519: 
1.897     wenzelju 6520: ol.LC_primary_menu a:hover,
1.721     harmsja  6521: ol#LC_MenuBreadcrumbs a:hover,
                   6522: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6523: ul#LC_secondary_menu a:hover,
1.721     harmsja  6524: .LC_FormSectionClearButton input:hover
1.795     www      6525: ul.LC_TabContent   li:hover a {
1.952     onken    6526:   color:$button_hover;
1.911     bisitz   6527:   text-decoration:none;
1.693     droeschl 6528: }
                   6529: 
1.779     bisitz   6530: h1 {
1.911     bisitz   6531:   padding: 0;
                   6532:   line-height:130%;
1.693     droeschl 6533: }
1.698     harmsja  6534: 
1.911     bisitz   6535: h2,
                   6536: h3,
                   6537: h4,
                   6538: h5,
                   6539: h6 {
                   6540:   margin: 5px 0 5px 0;
                   6541:   padding: 0;
                   6542:   line-height:130%;
1.693     droeschl 6543: }
1.795     www      6544: 
                   6545: .LC_hcell {
1.911     bisitz   6546:   padding:3px 15px 3px 15px;
                   6547:   margin: 0;
                   6548:   background-color:$tabbg;
                   6549:   color:$fontmenu;
                   6550:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6551: }
1.795     www      6552: 
1.840     bisitz   6553: .LC_Box > .LC_hcell {
1.911     bisitz   6554:   margin: 0 -10px 10px -10px;
1.835     bisitz   6555: }
                   6556: 
1.721     harmsja  6557: .LC_noBorder {
1.911     bisitz   6558:   border: 0;
1.698     harmsja  6559: }
1.693     droeschl 6560: 
1.721     harmsja  6561: .LC_FormSectionClearButton input {
1.911     bisitz   6562:   background-color:transparent;
                   6563:   border: none;
                   6564:   cursor:pointer;
                   6565:   text-decoration:underline;
1.693     droeschl 6566: }
1.763     bisitz   6567: 
                   6568: .LC_help_open_topic {
1.911     bisitz   6569:   color: #FFFFFF;
                   6570:   background-color: #EEEEFF;
                   6571:   margin: 1px;
                   6572:   padding: 4px;
                   6573:   border: 1px solid #000033;
                   6574:   white-space: nowrap;
                   6575:   /* vertical-align: middle; */
1.759     neumanie 6576: }
1.693     droeschl 6577: 
1.911     bisitz   6578: dl,
                   6579: ul,
                   6580: div,
                   6581: fieldset {
                   6582:   margin: 10px 10px 10px 0;
                   6583:   /* overflow: hidden; */
1.693     droeschl 6584: }
1.795     www      6585: 
1.838     bisitz   6586: fieldset > legend {
1.911     bisitz   6587:   font-weight: bold;
                   6588:   padding: 0 5px 0 5px;
1.838     bisitz   6589: }
                   6590: 
1.813     bisitz   6591: #LC_nav_bar {
1.911     bisitz   6592:   float: left;
1.995     raeburn  6593:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6594:   margin: 0 0 2px 0;
1.807     droeschl 6595: }
                   6596: 
1.916     droeschl 6597: #LC_realm {
                   6598:   margin: 0.2em 0 0 0;
                   6599:   padding: 0;
                   6600:   font-weight: bold;
                   6601:   text-align: center;
1.995     raeburn  6602:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6603: }
                   6604: 
1.911     bisitz   6605: #LC_nav_bar em {
                   6606:   font-weight: bold;
                   6607:   font-style: normal;
1.807     droeschl 6608: }
                   6609: 
1.897     wenzelju 6610: ol.LC_primary_menu {
1.934     droeschl 6611:   margin: 0;
1.1076    raeburn  6612:   padding: 0;
1.995     raeburn  6613:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6614: }
                   6615: 
1.852     droeschl 6616: ol#LC_PathBreadcrumbs {
1.911     bisitz   6617:   margin: 0;
1.693     droeschl 6618: }
                   6619: 
1.897     wenzelju 6620: ol.LC_primary_menu li {
1.1076    raeburn  6621:   color: RGB(80, 80, 80);
                   6622:   vertical-align: middle;
                   6623:   text-align: left;
                   6624:   list-style: none;
                   6625:   float: left;
                   6626: }
                   6627: 
                   6628: ol.LC_primary_menu li a {
                   6629:   display: block;
                   6630:   margin: 0;
                   6631:   padding: 0 5px 0 10px;
                   6632:   text-decoration: none;
                   6633: }
                   6634: 
                   6635: ol.LC_primary_menu li ul {
                   6636:   display: none;
                   6637:   width: 10em;
                   6638:   background-color: $data_table_light;
                   6639: }
                   6640: 
                   6641: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6642:   display: block;
                   6643:   position: absolute;
                   6644:   margin: 0;
                   6645:   padding: 0;
1.1078    raeburn  6646:   z-index: 2;
1.1076    raeburn  6647: }
                   6648: 
                   6649: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6650:   font-size: 90%;
1.911     bisitz   6651:   vertical-align: top;
1.1076    raeburn  6652:   float: none;
1.1079    raeburn  6653:   border-left: 1px solid black;
                   6654:   border-right: 1px solid black;
1.1076    raeburn  6655: }
                   6656: 
                   6657: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1078    raeburn  6658:   background-color:$data_table_light;
1.1076    raeburn  6659: }
                   6660: 
                   6661: ol.LC_primary_menu li li a:hover {
                   6662:    color:$button_hover;
                   6663:    background-color:$data_table_dark;
1.693     droeschl 6664: }
                   6665: 
1.897     wenzelju 6666: ol.LC_primary_menu li img {
1.911     bisitz   6667:   vertical-align: bottom;
1.934     droeschl 6668:   height: 1.1em;
1.1077    raeburn  6669:   margin: 0.2em 0 0 0;
1.693     droeschl 6670: }
                   6671: 
1.897     wenzelju 6672: ol.LC_primary_menu a {
1.911     bisitz   6673:   color: RGB(80, 80, 80);
                   6674:   text-decoration: none;
1.693     droeschl 6675: }
1.795     www      6676: 
1.949     droeschl 6677: ol.LC_primary_menu a.LC_new_message {
                   6678:   font-weight:bold;
                   6679:   color: darkred;
                   6680: }
                   6681: 
1.975     raeburn  6682: ol.LC_docs_parameters {
                   6683:   margin-left: 0;
                   6684:   padding: 0;
                   6685:   list-style: none;
                   6686: }
                   6687: 
                   6688: ol.LC_docs_parameters li {
                   6689:   margin: 0;
                   6690:   padding-right: 20px;
                   6691:   display: inline;
                   6692: }
                   6693: 
1.976     raeburn  6694: ol.LC_docs_parameters li:before {
                   6695:   content: "\\002022 \\0020";
                   6696: }
                   6697: 
                   6698: li.LC_docs_parameters_title {
                   6699:   font-weight: bold;
                   6700: }
                   6701: 
                   6702: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6703:   content: "";
                   6704: }
                   6705: 
1.897     wenzelju 6706: ul#LC_secondary_menu {
1.1107    raeburn  6707:   clear: right;
1.911     bisitz   6708:   color: $fontmenu;
                   6709:   background: $tabbg;
                   6710:   list-style: none;
                   6711:   padding: 0;
                   6712:   margin: 0;
                   6713:   width: 100%;
1.995     raeburn  6714:   text-align: left;
1.1107    raeburn  6715:   float: left;
1.808     droeschl 6716: }
                   6717: 
1.897     wenzelju 6718: ul#LC_secondary_menu li {
1.911     bisitz   6719:   font-weight: bold;
                   6720:   line-height: 1.8em;
1.1107    raeburn  6721:   border-right: 1px solid black;
                   6722:   float: left;
                   6723: }
                   6724: 
                   6725: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6726:   background-color: $data_table_light;
                   6727: }
                   6728: 
                   6729: ul#LC_secondary_menu li a {
1.911     bisitz   6730:   padding: 0 0.8em;
1.1107    raeburn  6731: }
                   6732: 
                   6733: ul#LC_secondary_menu li ul {
                   6734:   display: none;
                   6735: }
                   6736: 
                   6737: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6738:   display: block;
                   6739:   position: absolute;
                   6740:   margin: 0;
                   6741:   padding: 0;
                   6742:   list-style:none;
                   6743:   float: none;
                   6744:   background-color: $data_table_light;
                   6745:   z-index: 2;
                   6746:   margin-left: -1px;
                   6747: }
                   6748: 
                   6749: ul#LC_secondary_menu li ul li {
                   6750:   font-size: 90%;
                   6751:   vertical-align: top;
                   6752:   border-left: 1px solid black;
1.911     bisitz   6753:   border-right: 1px solid black;
1.1119    raeburn  6754:   background-color: $data_table_light;
1.1107    raeburn  6755:   list-style:none;
                   6756:   float: none;
                   6757: }
                   6758: 
                   6759: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6760:   background-color: $data_table_dark;
1.807     droeschl 6761: }
                   6762: 
1.847     tempelho 6763: ul.LC_TabContent {
1.911     bisitz   6764:   display:block;
                   6765:   background: $sidebg;
                   6766:   border-bottom: solid 1px $lg_border_color;
                   6767:   list-style:none;
1.1020    raeburn  6768:   margin: -1px -10px 0 -10px;
1.911     bisitz   6769:   padding: 0;
1.693     droeschl 6770: }
                   6771: 
1.795     www      6772: ul.LC_TabContent li,
                   6773: ul.LC_TabContentBigger li {
1.911     bisitz   6774:   float:left;
1.741     harmsja  6775: }
1.795     www      6776: 
1.897     wenzelju 6777: ul#LC_secondary_menu li a {
1.911     bisitz   6778:   color: $fontmenu;
                   6779:   text-decoration: none;
1.693     droeschl 6780: }
1.795     www      6781: 
1.721     harmsja  6782: ul.LC_TabContent {
1.952     onken    6783:   min-height:20px;
1.721     harmsja  6784: }
1.795     www      6785: 
                   6786: ul.LC_TabContent li {
1.911     bisitz   6787:   vertical-align:middle;
1.959     onken    6788:   padding: 0 16px 0 10px;
1.911     bisitz   6789:   background-color:$tabbg;
                   6790:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6791:   border-left: solid 1px $font;
1.721     harmsja  6792: }
1.795     www      6793: 
1.847     tempelho 6794: ul.LC_TabContent .right {
1.911     bisitz   6795:   float:right;
1.847     tempelho 6796: }
                   6797: 
1.911     bisitz   6798: ul.LC_TabContent li a,
                   6799: ul.LC_TabContent li {
                   6800:   color:rgb(47,47,47);
                   6801:   text-decoration:none;
                   6802:   font-size:95%;
                   6803:   font-weight:bold;
1.952     onken    6804:   min-height:20px;
                   6805: }
                   6806: 
1.959     onken    6807: ul.LC_TabContent li a:hover,
                   6808: ul.LC_TabContent li a:focus {
1.952     onken    6809:   color: $button_hover;
1.959     onken    6810:   background:none;
                   6811:   outline:none;
1.952     onken    6812: }
                   6813: 
                   6814: ul.LC_TabContent li:hover {
                   6815:   color: $button_hover;
                   6816:   cursor:pointer;
1.721     harmsja  6817: }
1.795     www      6818: 
1.911     bisitz   6819: ul.LC_TabContent li.active {
1.952     onken    6820:   color: $font;
1.911     bisitz   6821:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6822:   border-bottom:solid 1px #FFFFFF;
                   6823:   cursor: default;
1.744     ehlerst  6824: }
1.795     www      6825: 
1.959     onken    6826: ul.LC_TabContent li.active a {
                   6827:   color:$font;
                   6828:   background:#FFFFFF;
                   6829:   outline: none;
                   6830: }
1.1047    raeburn  6831: 
                   6832: ul.LC_TabContent li.goback {
                   6833:   float: left;
                   6834:   border-left: none;
                   6835: }
                   6836: 
1.870     tempelho 6837: #maincoursedoc {
1.911     bisitz   6838:   clear:both;
1.870     tempelho 6839: }
                   6840: 
                   6841: ul.LC_TabContentBigger {
1.911     bisitz   6842:   display:block;
                   6843:   list-style:none;
                   6844:   padding: 0;
1.870     tempelho 6845: }
                   6846: 
1.795     www      6847: ul.LC_TabContentBigger li {
1.911     bisitz   6848:   vertical-align:bottom;
                   6849:   height: 30px;
                   6850:   font-size:110%;
                   6851:   font-weight:bold;
                   6852:   color: #737373;
1.841     tempelho 6853: }
                   6854: 
1.957     onken    6855: ul.LC_TabContentBigger li.active {
                   6856:   position: relative;
                   6857:   top: 1px;
                   6858: }
                   6859: 
1.870     tempelho 6860: ul.LC_TabContentBigger li a {
1.911     bisitz   6861:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6862:   height: 30px;
                   6863:   line-height: 30px;
                   6864:   text-align: center;
                   6865:   display: block;
                   6866:   text-decoration: none;
1.958     onken    6867:   outline: none;  
1.741     harmsja  6868: }
1.795     www      6869: 
1.870     tempelho 6870: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6871:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6872:   color:$font;
1.744     ehlerst  6873: }
1.795     www      6874: 
1.870     tempelho 6875: ul.LC_TabContentBigger li b {
1.911     bisitz   6876:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6877:   display: block;
                   6878:   float: left;
                   6879:   padding: 0 30px;
1.957     onken    6880:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6881: }
                   6882: 
1.956     onken    6883: ul.LC_TabContentBigger li:hover b {
                   6884:   color:$button_hover;
                   6885: }
                   6886: 
1.870     tempelho 6887: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6888:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6889:   color:$font;
1.957     onken    6890:   border: 0;
1.741     harmsja  6891: }
1.693     droeschl 6892: 
1.870     tempelho 6893: 
1.862     bisitz   6894: ul.LC_CourseBreadcrumbs {
                   6895:   background: $sidebg;
1.1020    raeburn  6896:   height: 2em;
1.862     bisitz   6897:   padding-left: 10px;
1.1020    raeburn  6898:   margin: 0;
1.862     bisitz   6899:   list-style-position: inside;
                   6900: }
                   6901: 
1.911     bisitz   6902: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6903: ol#LC_PathBreadcrumbs {
1.911     bisitz   6904:   padding-left: 10px;
                   6905:   margin: 0;
1.933     droeschl 6906:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6907: }
                   6908: 
1.911     bisitz   6909: ol#LC_MenuBreadcrumbs li,
                   6910: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6911: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6912:   display: inline;
1.933     droeschl 6913:   white-space: normal;  
1.693     droeschl 6914: }
                   6915: 
1.823     bisitz   6916: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6917: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6918:   text-decoration: none;
                   6919:   font-size:90%;
1.693     droeschl 6920: }
1.795     www      6921: 
1.969     droeschl 6922: ol#LC_MenuBreadcrumbs h1 {
                   6923:   display: inline;
                   6924:   font-size: 90%;
                   6925:   line-height: 2.5em;
                   6926:   margin: 0;
                   6927:   padding: 0;
                   6928: }
                   6929: 
1.795     www      6930: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6931:   text-decoration:none;
                   6932:   font-size:100%;
                   6933:   font-weight:bold;
1.693     droeschl 6934: }
1.795     www      6935: 
1.840     bisitz   6936: .LC_Box {
1.911     bisitz   6937:   border: solid 1px $lg_border_color;
                   6938:   padding: 0 10px 10px 10px;
1.746     neumanie 6939: }
1.795     www      6940: 
1.1020    raeburn  6941: .LC_DocsBox {
                   6942:   border: solid 1px $lg_border_color;
                   6943:   padding: 0 0 10px 10px;
                   6944: }
                   6945: 
1.795     www      6946: .LC_AboutMe_Image {
1.911     bisitz   6947:   float:left;
                   6948:   margin-right:10px;
1.747     neumanie 6949: }
1.795     www      6950: 
                   6951: .LC_Clear_AboutMe_Image {
1.911     bisitz   6952:   clear:left;
1.747     neumanie 6953: }
1.795     www      6954: 
1.721     harmsja  6955: dl.LC_ListStyleClean dt {
1.911     bisitz   6956:   padding-right: 5px;
                   6957:   display: table-header-group;
1.693     droeschl 6958: }
                   6959: 
1.721     harmsja  6960: dl.LC_ListStyleClean dd {
1.911     bisitz   6961:   display: table-row;
1.693     droeschl 6962: }
                   6963: 
1.721     harmsja  6964: .LC_ListStyleClean,
                   6965: .LC_ListStyleSimple,
                   6966: .LC_ListStyleNormal,
1.795     www      6967: .LC_ListStyleSpecial {
1.911     bisitz   6968:   /* display:block; */
                   6969:   list-style-position: inside;
                   6970:   list-style-type: none;
                   6971:   overflow: hidden;
                   6972:   padding: 0;
1.693     droeschl 6973: }
                   6974: 
1.721     harmsja  6975: .LC_ListStyleSimple li,
                   6976: .LC_ListStyleSimple dd,
                   6977: .LC_ListStyleNormal li,
                   6978: .LC_ListStyleNormal dd,
                   6979: .LC_ListStyleSpecial li,
1.795     www      6980: .LC_ListStyleSpecial dd {
1.911     bisitz   6981:   margin: 0;
                   6982:   padding: 5px 5px 5px 10px;
                   6983:   clear: both;
1.693     droeschl 6984: }
                   6985: 
1.721     harmsja  6986: .LC_ListStyleClean li,
                   6987: .LC_ListStyleClean dd {
1.911     bisitz   6988:   padding-top: 0;
                   6989:   padding-bottom: 0;
1.693     droeschl 6990: }
                   6991: 
1.721     harmsja  6992: .LC_ListStyleSimple dd,
1.795     www      6993: .LC_ListStyleSimple li {
1.911     bisitz   6994:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 6995: }
                   6996: 
1.721     harmsja  6997: .LC_ListStyleSpecial li,
                   6998: .LC_ListStyleSpecial dd {
1.911     bisitz   6999:   list-style-type: none;
                   7000:   background-color: RGB(220, 220, 220);
                   7001:   margin-bottom: 4px;
1.693     droeschl 7002: }
                   7003: 
1.721     harmsja  7004: table.LC_SimpleTable {
1.911     bisitz   7005:   margin:5px;
                   7006:   border:solid 1px $lg_border_color;
1.795     www      7007: }
1.693     droeschl 7008: 
1.721     harmsja  7009: table.LC_SimpleTable tr {
1.911     bisitz   7010:   padding: 0;
                   7011:   border:solid 1px $lg_border_color;
1.693     droeschl 7012: }
1.795     www      7013: 
                   7014: table.LC_SimpleTable thead {
1.911     bisitz   7015:   background:rgb(220,220,220);
1.693     droeschl 7016: }
                   7017: 
1.721     harmsja  7018: div.LC_columnSection {
1.911     bisitz   7019:   display: block;
                   7020:   clear: both;
                   7021:   overflow: hidden;
                   7022:   margin: 0;
1.693     droeschl 7023: }
                   7024: 
1.721     harmsja  7025: div.LC_columnSection>* {
1.911     bisitz   7026:   float: left;
                   7027:   margin: 10px 20px 10px 0;
                   7028:   overflow:hidden;
1.693     droeschl 7029: }
1.721     harmsja  7030: 
1.795     www      7031: table em {
1.911     bisitz   7032:   font-weight: bold;
                   7033:   font-style: normal;
1.748     schulted 7034: }
1.795     www      7035: 
1.779     bisitz   7036: table.LC_tableBrowseRes,
1.795     www      7037: table.LC_tableOfContent {
1.911     bisitz   7038:   border:none;
                   7039:   border-spacing: 1px;
                   7040:   padding: 3px;
                   7041:   background-color: #FFFFFF;
                   7042:   font-size: 90%;
1.753     droeschl 7043: }
1.789     droeschl 7044: 
1.911     bisitz   7045: table.LC_tableOfContent {
                   7046:   border-collapse: collapse;
1.789     droeschl 7047: }
                   7048: 
1.771     droeschl 7049: table.LC_tableBrowseRes a,
1.768     schulted 7050: table.LC_tableOfContent a {
1.911     bisitz   7051:   background-color: transparent;
                   7052:   text-decoration: none;
1.753     droeschl 7053: }
                   7054: 
1.795     www      7055: table.LC_tableOfContent img {
1.911     bisitz   7056:   border: none;
                   7057:   height: 1.3em;
                   7058:   vertical-align: text-bottom;
                   7059:   margin-right: 0.3em;
1.753     droeschl 7060: }
1.757     schulted 7061: 
1.795     www      7062: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7063:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7064: }
                   7065: 
1.795     www      7066: a#LC_content_toolbar_everything {
1.911     bisitz   7067:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7068: }
                   7069: 
1.795     www      7070: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7071:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7072: }
                   7073: 
1.795     www      7074: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7075:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7076: }
                   7077: 
1.795     www      7078: a#LC_content_toolbar_changefolder {
1.911     bisitz   7079:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7080: }
                   7081: 
1.795     www      7082: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7083:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7084: }
                   7085: 
1.1043    raeburn  7086: a#LC_content_toolbar_edittoplevel {
                   7087:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7088: }
                   7089: 
1.795     www      7090: ul#LC_toolbar li a:hover {
1.911     bisitz   7091:   background-position: bottom center;
1.757     schulted 7092: }
                   7093: 
1.795     www      7094: ul#LC_toolbar {
1.911     bisitz   7095:   padding: 0;
                   7096:   margin: 2px;
                   7097:   list-style:none;
                   7098:   position:relative;
                   7099:   background-color:white;
1.1082    raeburn  7100:   overflow: auto;
1.757     schulted 7101: }
                   7102: 
1.795     www      7103: ul#LC_toolbar li {
1.911     bisitz   7104:   border:1px solid white;
                   7105:   padding: 0;
                   7106:   margin: 0;
                   7107:   float: left;
                   7108:   display:inline;
                   7109:   vertical-align:middle;
1.1082    raeburn  7110:   white-space: nowrap;
1.911     bisitz   7111: }
1.757     schulted 7112: 
1.783     amueller 7113: 
1.795     www      7114: a.LC_toolbarItem {
1.911     bisitz   7115:   display:block;
                   7116:   padding: 0;
                   7117:   margin: 0;
                   7118:   height: 32px;
                   7119:   width: 32px;
                   7120:   color:white;
                   7121:   border: none;
                   7122:   background-repeat:no-repeat;
                   7123:   background-color:transparent;
1.757     schulted 7124: }
                   7125: 
1.915     droeschl 7126: ul.LC_funclist {
                   7127:     margin: 0;
                   7128:     padding: 0.5em 1em 0.5em 0;
                   7129: }
                   7130: 
1.933     droeschl 7131: ul.LC_funclist > li:first-child {
                   7132:     font-weight:bold; 
                   7133:     margin-left:0.8em;
                   7134: }
                   7135: 
1.915     droeschl 7136: ul.LC_funclist + ul.LC_funclist {
                   7137:     /* 
                   7138:        left border as a seperator if we have more than
                   7139:        one list 
                   7140:     */
                   7141:     border-left: 1px solid $sidebg;
                   7142:     /* 
                   7143:        this hides the left border behind the border of the 
                   7144:        outer box if element is wrapped to the next 'line' 
                   7145:     */
                   7146:     margin-left: -1px;
                   7147: }
                   7148: 
1.843     bisitz   7149: ul.LC_funclist li {
1.915     droeschl 7150:   display: inline;
1.782     bisitz   7151:   white-space: nowrap;
1.915     droeschl 7152:   margin: 0 0 0 25px;
                   7153:   line-height: 150%;
1.782     bisitz   7154: }
                   7155: 
1.974     wenzelju 7156: .LC_hidden {
                   7157:   display: none;
                   7158: }
                   7159: 
1.1030    www      7160: .LCmodal-overlay {
                   7161: 		position:fixed;
                   7162: 		top:0;
                   7163: 		right:0;
                   7164: 		bottom:0;
                   7165: 		left:0;
                   7166: 		height:100%;
                   7167: 		width:100%;
                   7168: 		margin:0;
                   7169: 		padding:0;
                   7170: 		background:#999;
                   7171: 		opacity:.75;
                   7172: 		filter: alpha(opacity=75);
                   7173: 		-moz-opacity: 0.75;
                   7174: 		z-index:101;
                   7175: }
                   7176: 
                   7177: * html .LCmodal-overlay {   
                   7178: 		position: absolute;
                   7179: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7180: }
                   7181: 
                   7182: .LCmodal-window {
                   7183: 		position:fixed;
                   7184: 		top:50%;
                   7185: 		left:50%;
                   7186: 		margin:0;
                   7187: 		padding:0;
                   7188: 		z-index:102;
                   7189: 	}
                   7190: 
                   7191: * html .LCmodal-window {
                   7192: 		position:absolute;
                   7193: }
                   7194: 
                   7195: .LCclose-window {
                   7196: 		position:absolute;
                   7197: 		width:32px;
                   7198: 		height:32px;
                   7199: 		right:8px;
                   7200: 		top:8px;
                   7201: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7202: 		text-indent:-99999px;
                   7203: 		overflow:hidden;
                   7204: 		cursor:pointer;
                   7205: }
                   7206: 
1.1100    raeburn  7207: /*
                   7208:   styles used by TTH when "Default set of options to pass to tth/m
                   7209:   when converting TeX" in course settings has been set
                   7210: 
                   7211:   option passed: -t
                   7212: 
                   7213: */
                   7214: 
                   7215: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7216: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7217: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7218: td div.norm {line-height:normal;}
                   7219: 
                   7220: /*
                   7221:   option passed -y3
                   7222: */
                   7223: 
                   7224: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7225: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7226: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7227: 
1.343     albertel 7228: END
                   7229: }
                   7230: 
1.306     albertel 7231: =pod
                   7232: 
                   7233: =item * &headtag()
                   7234: 
                   7235: Returns a uniform footer for LON-CAPA web pages.
                   7236: 
1.307     albertel 7237: Inputs: $title - optional title for the head
                   7238:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7239:         $args - optional arguments
1.319     albertel 7240:             force_register - if is true call registerurl so the remote is 
                   7241:                              informed
1.415     albertel 7242:             redirect       -> array ref of
                   7243:                                    1- seconds before redirect occurs
                   7244:                                    2- url to redirect to
                   7245:                                    3- whether the side effect should occur
1.315     albertel 7246:                            (side effect of setting 
                   7247:                                $env{'internal.head.redirect'} to the url 
                   7248:                                redirected too)
1.352     albertel 7249:             domain         -> force to color decorate a page for a specific
                   7250:                                domain
                   7251:             function       -> force usage of a specific rolish color scheme
                   7252:             bgcolor        -> override the default page bgcolor
1.460     albertel 7253:             no_auto_mt_title
                   7254:                            -> prevent &mt()ing the title arg
1.464     albertel 7255: 
1.306     albertel 7256: =cut
                   7257: 
                   7258: sub headtag {
1.313     albertel 7259:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7260:     
1.363     albertel 7261:     my $function = $args->{'function'} || &get_users_function();
                   7262:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7263:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 7264:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7265: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7266: 		   #time(),
1.418     albertel 7267: 		   $env{'environment.color.timestamp'},
1.363     albertel 7268: 		   $function,$domain,$bgcolor);
                   7269: 
1.369     www      7270:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7271: 
1.308     albertel 7272:     my $result =
                   7273: 	'<head>'.
1.461     albertel 7274: 	&font_settings();
1.319     albertel 7275: 
1.1064    raeburn  7276:     my $inhibitprint = &print_suppression();
                   7277: 
1.461     albertel 7278:     if (!$args->{'frameset'}) {
                   7279: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7280:     }
1.962     droeschl 7281:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   7282:         $result .= Apache::lonxml::display_title();
1.319     albertel 7283:     }
1.436     albertel 7284:     if (!$args->{'no_nav_bar'} 
                   7285: 	&& !$args->{'only_body'}
                   7286: 	&& !$args->{'frameset'}) {
                   7287: 	$result .= &help_menu_js();
1.1032    www      7288:         $result.=&modal_window();
1.1038    www      7289:         $result.=&togglebox_script();
1.1034    www      7290:         $result.=&wishlist_window();
1.1041    www      7291:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7292:     } else {
                   7293:         if ($args->{'add_modal'}) {
                   7294:            $result.=&modal_window();
                   7295:         }
                   7296:         if ($args->{'add_wishlist'}) {
                   7297:            $result.=&wishlist_window();
                   7298:         }
1.1038    www      7299:         if ($args->{'add_togglebox'}) {
                   7300:            $result.=&togglebox_script();
                   7301:         }
1.1041    www      7302:         if ($args->{'add_progressbar'}) {
                   7303:            $result.=&LCprogressbarUpdate_script();
                   7304:         }
1.436     albertel 7305:     }
1.314     albertel 7306:     if (ref($args->{'redirect'})) {
1.414     albertel 7307: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7308: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7309: 	if (!$inhibit_continue) {
                   7310: 	    $env{'internal.head.redirect'} = $url;
                   7311: 	}
1.313     albertel 7312: 	$result.=<<ADDMETA
                   7313: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7314: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7315: ADDMETA
                   7316:     }
1.306     albertel 7317:     if (!defined($title)) {
                   7318: 	$title = 'The LearningOnline Network with CAPA';
                   7319:     }
1.460     albertel 7320:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7321:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 7322: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064    raeburn  7323:         .$inhibitprint
1.414     albertel 7324: 	.$head_extra;
1.1137    raeburn  7325:     if ($env{'browser.mobile'}) {
                   7326:         $result .= '
                   7327: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7328: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7329:     }
1.962     droeschl 7330:     return $result.'</head>';
1.306     albertel 7331: }
                   7332: 
                   7333: =pod
                   7334: 
1.340     albertel 7335: =item * &font_settings()
                   7336: 
                   7337: Returns neccessary <meta> to set the proper encoding
                   7338: 
                   7339: Inputs: none
                   7340: 
                   7341: =cut
                   7342: 
                   7343: sub font_settings {
                   7344:     my $headerstring='';
1.647     www      7345:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 7346: 	$headerstring.=
                   7347: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   7348:     }
                   7349:     return $headerstring;
                   7350: }
                   7351: 
1.341     albertel 7352: =pod
                   7353: 
1.1064    raeburn  7354: =item * &print_suppression()
                   7355: 
                   7356: In course context returns css which causes the body to be blank when media="print",
                   7357: if printout generation is unavailable for the current resource.
                   7358: 
                   7359: This could be because:
                   7360: 
                   7361: (a) printstartdate is in the future
                   7362: 
                   7363: (b) printenddate is in the past
                   7364: 
                   7365: (c) there is an active exam block with "printout"
                   7366: functionality blocked
                   7367: 
                   7368: Users with pav, pfo or evb privileges are exempt.
                   7369: 
                   7370: Inputs: none
                   7371: 
                   7372: =cut
                   7373: 
                   7374: 
                   7375: sub print_suppression {
                   7376:     my $noprint;
                   7377:     if ($env{'request.course.id'}) {
                   7378:         my $scope = $env{'request.course.id'};
                   7379:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7380:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7381:             return;
                   7382:         }
                   7383:         if ($env{'request.course.sec'} ne '') {
                   7384:             $scope .= "/$env{'request.course.sec'}";
                   7385:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7386:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7387:                 return;
1.1064    raeburn  7388:             }
                   7389:         }
                   7390:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7391:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7392:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7393:         if ($blocked) {
                   7394:             my $checkrole = "cm./$cdom/$cnum";
                   7395:             if ($env{'request.course.sec'} ne '') {
                   7396:                 $checkrole .= "/$env{'request.course.sec'}";
                   7397:             }
                   7398:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7399:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7400:                 $noprint = 1;
                   7401:             }
                   7402:         }
                   7403:         unless ($noprint) {
                   7404:             my $symb = &Apache::lonnet::symbread();
                   7405:             if ($symb ne '') {
                   7406:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7407:                 if (ref($navmap)) {
                   7408:                     my $res = $navmap->getBySymb($symb);
                   7409:                     if (ref($res)) {
                   7410:                         if (!$res->resprintable()) {
                   7411:                             $noprint = 1;
                   7412:                         }
                   7413:                     }
                   7414:                 }
                   7415:             }
                   7416:         }
                   7417:         if ($noprint) {
                   7418:             return <<"ENDSTYLE";
                   7419: <style type="text/css" media="print">
                   7420:     body { display:none }
                   7421: </style>
                   7422: ENDSTYLE
                   7423:         }
                   7424:     }
                   7425:     return;
                   7426: }
                   7427: 
                   7428: =pod
                   7429: 
1.341     albertel 7430: =item * &xml_begin()
                   7431: 
                   7432: Returns the needed doctype and <html>
                   7433: 
                   7434: Inputs: none
                   7435: 
                   7436: =cut
                   7437: 
                   7438: sub xml_begin {
                   7439:     my $output='';
                   7440: 
                   7441:     if ($env{'browser.mathml'}) {
                   7442: 	$output='<?xml version="1.0"?>'
                   7443:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7444: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7445:             
                   7446: #	    .'<!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">] >'
                   7447: 	    .'<!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">'
                   7448:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7449: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   7450:     } else {
1.849     bisitz   7451: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   7452:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 7453:     }
                   7454:     return $output;
                   7455: }
1.340     albertel 7456: 
                   7457: =pod
                   7458: 
1.306     albertel 7459: =item * &start_page()
                   7460: 
                   7461: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7462: 
1.648     raeburn  7463: Inputs:
                   7464: 
                   7465: =over 4
                   7466: 
                   7467: $title - optional title for the page
                   7468: 
                   7469: $head_extra - optional extra HTML to incude inside the <head>
                   7470: 
                   7471: $args - additional optional args supported are:
                   7472: 
                   7473: =over 8
                   7474: 
                   7475:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7476:                                     arg on
1.814     bisitz   7477:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7478:              add_entries    -> additional attributes to add to the  <body>
                   7479:              domain         -> force to color decorate a page for a 
1.317     albertel 7480:                                     specific domain
1.648     raeburn  7481:              function       -> force usage of a specific rolish color
1.317     albertel 7482:                                     scheme
1.648     raeburn  7483:              redirect       -> see &headtag()
                   7484:              bgcolor        -> override the default page bg color
                   7485:              js_ready       -> return a string ready for being used in 
1.317     albertel 7486:                                     a javascript writeln
1.648     raeburn  7487:              html_encode    -> return a string ready for being used in 
1.320     albertel 7488:                                     a html attribute
1.648     raeburn  7489:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7490:                                     $forcereg arg
1.648     raeburn  7491:              frameset       -> if true will start with a <frameset>
1.330     albertel 7492:                                     rather than <body>
1.648     raeburn  7493:              skip_phases    -> hash ref of 
1.338     albertel 7494:                                     head -> skip the <html><head> generation
                   7495:                                     body -> skip all <body> generation
1.648     raeburn  7496:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7497:              inherit_jsmath -> when creating popup window in a page,
                   7498:                                     should it have jsmath forced on by the
                   7499:                                     current page
1.867     kalberla 7500:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7501:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1096    raeburn  7502:              group          -> includes the current group, if page is for a 
                   7503:                                specific group  
1.361     albertel 7504: 
1.648     raeburn  7505: =back
1.460     albertel 7506: 
1.648     raeburn  7507: =back
1.562     albertel 7508: 
1.306     albertel 7509: =cut
                   7510: 
                   7511: sub start_page {
1.309     albertel 7512:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7513:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7514: 
1.315     albertel 7515:     $env{'internal.start_page'}++;
1.1096    raeburn  7516:     my ($result,@advtools);
1.964     droeschl 7517: 
1.338     albertel 7518:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      7519:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 7520:     }
                   7521:     
                   7522:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7523: 	if ($args->{'frameset'}) {
                   7524: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7525: 						$args->{'add_entries'});
                   7526: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7527:         } else {
                   7528:             $result .=
                   7529:                 &bodytag($title, 
                   7530:                          $args->{'function'},       $args->{'add_entries'},
                   7531:                          $args->{'only_body'},      $args->{'domain'},
                   7532:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096    raeburn  7533:                          $args->{'bgcolor'},        $args,
                   7534:                          \@advtools);
1.831     bisitz   7535:         }
1.330     albertel 7536:     }
1.338     albertel 7537: 
1.315     albertel 7538:     if ($args->{'js_ready'}) {
1.713     kaisler  7539: 		$result = &js_ready($result);
1.315     albertel 7540:     }
1.320     albertel 7541:     if ($args->{'html_encode'}) {
1.713     kaisler  7542: 		$result = &html_encode($result);
                   7543:     }
                   7544: 
1.813     bisitz   7545:     # Preparation for new and consistent functionlist at top of screen
                   7546:     # if ($args->{'functionlist'}) {
                   7547:     #            $result .= &build_functionlist();
                   7548:     #}
                   7549: 
1.964     droeschl 7550:     # Don't add anything more if only_body wanted or in const space
                   7551:     return $result if    $args->{'only_body'} 
                   7552:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7553: 
                   7554:     #Breadcrumbs
1.758     kaisler  7555:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7556: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7557: 		#if any br links exists, add them to the breadcrumbs
                   7558: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7559: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7560: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7561: 			}
                   7562: 		}
1.1096    raeburn  7563:                 # if @advtools array contains items add then to the breadcrumbs
                   7564:                 if (@advtools > 0) {
                   7565:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7566:                 }
1.758     kaisler  7567: 
                   7568: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7569: 		if(exists($args->{'bread_crumbs_component'})){
                   7570: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7571: 		}else{
                   7572: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7573: 		}
1.320     albertel 7574:     }
1.315     albertel 7575:     return $result;
1.306     albertel 7576: }
                   7577: 
                   7578: sub end_page {
1.315     albertel 7579:     my ($args) = @_;
                   7580:     $env{'internal.end_page'}++;
1.330     albertel 7581:     my $result;
1.335     albertel 7582:     if ($args->{'discussion'}) {
                   7583: 	my ($target,$parser);
                   7584: 	if (ref($args->{'discussion'})) {
                   7585: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7586: 				$args->{'discussion'}{'parser'});
                   7587: 	}
                   7588: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7589:     }
1.330     albertel 7590:     if ($args->{'frameset'}) {
                   7591: 	$result .= '</frameset>';
                   7592:     } else {
1.635     raeburn  7593: 	$result .= &endbodytag($args);
1.330     albertel 7594:     }
1.1080    raeburn  7595:     unless ($args->{'notbody'}) {
                   7596:         $result .= "\n</html>";
                   7597:     }
1.330     albertel 7598: 
1.315     albertel 7599:     if ($args->{'js_ready'}) {
1.317     albertel 7600: 	$result = &js_ready($result);
1.315     albertel 7601:     }
1.335     albertel 7602: 
1.320     albertel 7603:     if ($args->{'html_encode'}) {
                   7604: 	$result = &html_encode($result);
                   7605:     }
1.335     albertel 7606: 
1.315     albertel 7607:     return $result;
                   7608: }
                   7609: 
1.1034    www      7610: sub wishlist_window {
                   7611:     return(<<'ENDWISHLIST');
1.1046    raeburn  7612: <script type="text/javascript">
1.1034    www      7613: // <![CDATA[
                   7614: // <!-- BEGIN LON-CAPA Internal
                   7615: function set_wishlistlink(title, path) {
                   7616:     if (!title) {
                   7617:         title = document.title;
                   7618:         title = title.replace(/^LON-CAPA /,'');
                   7619:     }
                   7620:     if (!path) {
                   7621:         path = location.pathname;
                   7622:     }
                   7623:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7624:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7625: }
                   7626: // END LON-CAPA Internal -->
                   7627: // ]]>
                   7628: </script>
                   7629: ENDWISHLIST
                   7630: }
                   7631: 
1.1030    www      7632: sub modal_window {
                   7633:     return(<<'ENDMODAL');
1.1046    raeburn  7634: <script type="text/javascript">
1.1030    www      7635: // <![CDATA[
                   7636: // <!-- BEGIN LON-CAPA Internal
                   7637: var modalWindow = {
                   7638: 	parent:"body",
                   7639: 	windowId:null,
                   7640: 	content:null,
                   7641: 	width:null,
                   7642: 	height:null,
                   7643: 	close:function()
                   7644: 	{
                   7645: 	        $(".LCmodal-window").remove();
                   7646: 	        $(".LCmodal-overlay").remove();
                   7647: 	},
                   7648: 	open:function()
                   7649: 	{
                   7650: 		var modal = "";
                   7651: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7652: 		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;\">";
                   7653: 		modal += this.content;
                   7654: 		modal += "</div>";	
                   7655: 
                   7656: 		$(this.parent).append(modal);
                   7657: 
                   7658: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7659: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7660: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7661: 	}
                   7662: };
1.1140    raeburn  7663: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      7664: 	{
                   7665: 		modalWindow.windowId = "myModal";
                   7666: 		modalWindow.width = width;
                   7667: 		modalWindow.height = height;
1.1140    raeburn  7668: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'>&lt/iframe>";
1.1030    www      7669: 		modalWindow.open();
                   7670: 	};	
                   7671: // END LON-CAPA Internal -->
                   7672: // ]]>
                   7673: </script>
                   7674: ENDMODAL
                   7675: }
                   7676: 
                   7677: sub modal_link {
1.1140    raeburn  7678:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      7679:     unless ($width) { $width=480; }
                   7680:     unless ($height) { $height=400; }
1.1031    www      7681:     unless ($scrolling) { $scrolling='yes'; }
1.1140    raeburn  7682:     unless ($transparency) { $transparency='true'; }
                   7683: 
1.1074    raeburn  7684:     my $target_attr;
                   7685:     if (defined($target)) {
                   7686:         $target_attr = 'target="'.$target.'"';
                   7687:     }
                   7688:     return <<"ENDLINK";
1.1140    raeburn  7689: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  7690:            $linktext</a>
                   7691: ENDLINK
1.1030    www      7692: }
                   7693: 
1.1032    www      7694: sub modal_adhoc_script {
                   7695:     my ($funcname,$width,$height,$content)=@_;
                   7696:     return (<<ENDADHOC);
1.1046    raeburn  7697: <script type="text/javascript">
1.1032    www      7698: // <![CDATA[
                   7699:         var $funcname = function()
                   7700:         {
                   7701:                 modalWindow.windowId = "myModal";
                   7702:                 modalWindow.width = $width;
                   7703:                 modalWindow.height = $height;
                   7704:                 modalWindow.content = '$content';
                   7705:                 modalWindow.open();
                   7706:         };  
                   7707: // ]]>
                   7708: </script>
                   7709: ENDADHOC
                   7710: }
                   7711: 
1.1041    www      7712: sub modal_adhoc_inner {
                   7713:     my ($funcname,$width,$height,$content)=@_;
                   7714:     my $innerwidth=$width-20;
                   7715:     $content=&js_ready(
1.1140    raeburn  7716:                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   7717:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   7718:                  $content.
1.1041    www      7719:                  &end_scrollbox().
1.1140    raeburn  7720:                  &end_page()
1.1041    www      7721:              );
                   7722:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7723: }
                   7724: 
                   7725: sub modal_adhoc_window {
                   7726:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7727:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7728:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7729: }
                   7730: 
                   7731: sub modal_adhoc_launch {
                   7732:     my ($funcname,$width,$height,$content)=@_;
                   7733:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7734: <script type="text/javascript">
                   7735: // <![CDATA[
                   7736: $funcname();
                   7737: // ]]>
                   7738: </script>
                   7739: ENDLAUNCH
                   7740: }
                   7741: 
                   7742: sub modal_adhoc_close {
                   7743:     return (<<ENDCLOSE);
                   7744: <script type="text/javascript">
                   7745: // <![CDATA[
                   7746: modalWindow.close();
                   7747: // ]]>
                   7748: </script>
                   7749: ENDCLOSE
                   7750: }
                   7751: 
1.1038    www      7752: sub togglebox_script {
                   7753:    return(<<ENDTOGGLE);
                   7754: <script type="text/javascript"> 
                   7755: // <![CDATA[
                   7756: function LCtoggleDisplay(id,hidetext,showtext) {
                   7757:    link = document.getElementById(id + "link").childNodes[0];
                   7758:    with (document.getElementById(id).style) {
                   7759:       if (display == "none" ) {
                   7760:           display = "inline";
                   7761:           link.nodeValue = hidetext;
                   7762:         } else {
                   7763:           display = "none";
                   7764:           link.nodeValue = showtext;
                   7765:        }
                   7766:    }
                   7767: }
                   7768: // ]]>
                   7769: </script>
                   7770: ENDTOGGLE
                   7771: }
                   7772: 
1.1039    www      7773: sub start_togglebox {
                   7774:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7775:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7776:     unless ($showtext) { $showtext=&mt('show'); }
                   7777:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7778:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7779:     return &start_data_table().
                   7780:            &start_data_table_header_row().
                   7781:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7782:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7783:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7784:            &end_data_table_header_row().
                   7785:            '<tr id="'.$id.'" style="display:none""><td>';
                   7786: }
                   7787: 
                   7788: sub end_togglebox {
                   7789:     return '</td></tr>'.&end_data_table();
                   7790: }
                   7791: 
1.1041    www      7792: sub LCprogressbar_script {
1.1045    www      7793:    my ($id)=@_;
1.1041    www      7794:    return(<<ENDPROGRESS);
                   7795: <script type="text/javascript">
                   7796: // <![CDATA[
1.1045    www      7797: \$('#progressbar$id').progressbar({
1.1041    www      7798:   value: 0,
                   7799:   change: function(event, ui) {
                   7800:     var newVal = \$(this).progressbar('option', 'value');
                   7801:     \$('.pblabel', this).text(LCprogressTxt);
                   7802:   }
                   7803: });
                   7804: // ]]>
                   7805: </script>
                   7806: ENDPROGRESS
                   7807: }
                   7808: 
                   7809: sub LCprogressbarUpdate_script {
                   7810:    return(<<ENDPROGRESSUPDATE);
                   7811: <style type="text/css">
                   7812: .ui-progressbar { position:relative; }
                   7813: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7814: </style>
                   7815: <script type="text/javascript">
                   7816: // <![CDATA[
1.1045    www      7817: var LCprogressTxt='---';
                   7818: 
                   7819: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7820:    LCprogressTxt=progresstext;
1.1045    www      7821:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7822: }
                   7823: // ]]>
                   7824: </script>
                   7825: ENDPROGRESSUPDATE
                   7826: }
                   7827: 
1.1042    www      7828: my $LClastpercent;
1.1045    www      7829: my $LCidcnt;
                   7830: my $LCcurrentid;
1.1042    www      7831: 
1.1041    www      7832: sub LCprogressbar {
1.1042    www      7833:     my ($r)=(@_);
                   7834:     $LClastpercent=0;
1.1045    www      7835:     $LCidcnt++;
                   7836:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7837:     my $starting=&mt('Starting');
                   7838:     my $content=(<<ENDPROGBAR);
1.1045    www      7839:   <div id="progressbar$LCcurrentid">
1.1041    www      7840:     <span class="pblabel">$starting</span>
                   7841:   </div>
                   7842: ENDPROGBAR
1.1045    www      7843:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7844: }
                   7845: 
                   7846: sub LCprogressbarUpdate {
1.1042    www      7847:     my ($r,$val,$text)=@_;
                   7848:     unless ($val) { 
                   7849:        if ($LClastpercent) {
                   7850:            $val=$LClastpercent;
                   7851:        } else {
                   7852:            $val=0;
                   7853:        }
                   7854:     }
1.1041    www      7855:     if ($val<0) { $val=0; }
                   7856:     if ($val>100) { $val=0; }
1.1042    www      7857:     $LClastpercent=$val;
1.1041    www      7858:     unless ($text) { $text=$val.'%'; }
                   7859:     $text=&js_ready($text);
1.1044    www      7860:     &r_print($r,<<ENDUPDATE);
1.1041    www      7861: <script type="text/javascript">
                   7862: // <![CDATA[
1.1045    www      7863: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7864: // ]]>
                   7865: </script>
                   7866: ENDUPDATE
1.1035    www      7867: }
                   7868: 
1.1042    www      7869: sub LCprogressbarClose {
                   7870:     my ($r)=@_;
                   7871:     $LClastpercent=0;
1.1044    www      7872:     &r_print($r,<<ENDCLOSE);
1.1042    www      7873: <script type="text/javascript">
                   7874: // <![CDATA[
1.1045    www      7875: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7876: // ]]>
                   7877: </script>
                   7878: ENDCLOSE
1.1044    www      7879: }
                   7880: 
                   7881: sub r_print {
                   7882:     my ($r,$to_print)=@_;
                   7883:     if ($r) {
                   7884:       $r->print($to_print);
                   7885:       $r->rflush();
                   7886:     } else {
                   7887:       print($to_print);
                   7888:     }
1.1042    www      7889: }
                   7890: 
1.320     albertel 7891: sub html_encode {
                   7892:     my ($result) = @_;
                   7893: 
1.322     albertel 7894:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7895:     
                   7896:     return $result;
                   7897: }
1.1044    www      7898: 
1.317     albertel 7899: sub js_ready {
                   7900:     my ($result) = @_;
                   7901: 
1.323     albertel 7902:     $result =~ s/[\n\r]/ /xmsg;
                   7903:     $result =~ s/\\/\\\\/xmsg;
                   7904:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7905:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7906:     
                   7907:     return $result;
                   7908: }
                   7909: 
1.315     albertel 7910: sub validate_page {
                   7911:     if (  exists($env{'internal.start_page'})
1.316     albertel 7912: 	  &&     $env{'internal.start_page'} > 1) {
                   7913: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7914: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7915: 				 $ENV{'request.filename'});
1.315     albertel 7916:     }
                   7917:     if (  exists($env{'internal.end_page'})
1.316     albertel 7918: 	  &&     $env{'internal.end_page'} > 1) {
                   7919: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7920: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7921: 				 $env{'request.filename'});
1.315     albertel 7922:     }
                   7923:     if (     exists($env{'internal.start_page'})
                   7924: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7925: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7926: 				 $env{'request.filename'});
1.315     albertel 7927:     }
                   7928:     if (   ! exists($env{'internal.start_page'})
                   7929: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7930: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7931: 				 $env{'request.filename'});
1.315     albertel 7932:     }
1.306     albertel 7933: }
1.315     albertel 7934: 
1.996     www      7935: 
                   7936: sub start_scrollbox {
1.1140    raeburn  7937:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  7938:     unless ($outerwidth) { $outerwidth='520px'; }
                   7939:     unless ($width) { $width='500px'; }
                   7940:     unless ($height) { $height='200px'; }
1.1075    raeburn  7941:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7942:     if ($id ne '') {
1.1140    raeburn  7943:         $table_id = ' id="table_'.$id.'"';
1.1137    raeburn  7944:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  7945:     }
1.1075    raeburn  7946:     if ($bgcolor ne '') {
                   7947:         $tdcol = "background-color: $bgcolor;";
                   7948:     }
1.1137    raeburn  7949:     my $nicescroll_js;
                   7950:     if ($env{'browser.mobile'}) {
1.1140    raeburn  7951:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   7952:     }
                   7953:     return <<"END";
                   7954: $nicescroll_js
                   7955: 
                   7956: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   7957: <div style="overflow:auto; width:$width; height:$height;"$div_id>
                   7958: END
                   7959: }
                   7960: 
                   7961: sub end_scrollbox {
                   7962:     return '</div></td></tr></table>';
                   7963: }
                   7964: 
                   7965: sub nicescroll_javascript {
                   7966:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   7967:     my %options;
                   7968:     if (ref($cursor) eq 'HASH') {
                   7969:         %options = %{$cursor};
                   7970:     }
                   7971:     unless ($options{'railalign'} =~ /^left|right$/) {
                   7972:         $options{'railalign'} = 'left';
                   7973:     }
                   7974:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   7975:         my $function  = &get_users_function();
                   7976:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138    raeburn  7977:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140    raeburn  7978:             $options{'cursorcolor'} = '#00F';
1.1138    raeburn  7979:         }
1.1140    raeburn  7980:     }
                   7981:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   7982:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138    raeburn  7983:             $options{'cursoropacity'}='1.0';
                   7984:         }
1.1140    raeburn  7985:     } else {
                   7986:         $options{'cursoropacity'}='1.0';
                   7987:     }
                   7988:     if ($options{'cursorfixedheight'} eq 'none') {
                   7989:         delete($options{'cursorfixedheight'});
                   7990:     } else {
                   7991:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   7992:     }
                   7993:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   7994:         delete($options{'railoffset'});
                   7995:     }
                   7996:     my @niceoptions;
                   7997:     while (my($key,$value) = each(%options)) {
                   7998:         if ($value =~ /^\{.+\}$/) {
                   7999:             push(@niceoptions,$key.':'.$value);
1.1138    raeburn  8000:         } else {
1.1140    raeburn  8001:             push(@niceoptions,$key.':"'.$value.'"');
1.1138    raeburn  8002:         }
1.1140    raeburn  8003:     }
                   8004:     my $nicescroll_js = '
1.1137    raeburn  8005: $(document).ready(
1.1140    raeburn  8006:       function() {
                   8007:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8008:       }
1.1137    raeburn  8009: );
                   8010: ';
1.1140    raeburn  8011:     if ($framecheck) {
                   8012:         $nicescroll_js .= '
                   8013: function expand_div(caller) {
                   8014:     if (top === self) {
                   8015:         document.getElementById("'.$id.'").style.width = "auto";
                   8016:         document.getElementById("'.$id.'").style.height = "auto";
                   8017:     } else {
                   8018:         try {
                   8019:             if (parent.frames) {
                   8020:                 if (parent.frames.length > 1) {
                   8021:                     var framesrc = parent.frames[1].location.href;
                   8022:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8023:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8024:                         document.getElementById("'.$id.'").style.width = "auto";
                   8025:                         document.getElementById("'.$id.'").style.height = "auto";
                   8026:                     }
                   8027:                 }
                   8028:             }
                   8029:         } catch (e) {
                   8030:             return;
                   8031:         }
1.1137    raeburn  8032:     }
1.1140    raeburn  8033:     return;
1.996     www      8034: }
1.1140    raeburn  8035: ';
                   8036:     }
                   8037:     if ($needjsready) {
                   8038:         $nicescroll_js = '
                   8039: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8040:     } else {
                   8041:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8042:     }
                   8043:     return $nicescroll_js;
1.996     www      8044: }
                   8045: 
1.318     albertel 8046: sub simple_error_page {
                   8047:     my ($r,$title,$msg) = @_;
                   8048:     my $page =
                   8049: 	&Apache::loncommon::start_page($title).
1.1097    bisitz   8050: 	'<p class="LC_error">'.&mt($msg).'</p>'.
1.318     albertel 8051: 	&Apache::loncommon::end_page();
                   8052:     if (ref($r)) {
                   8053: 	$r->print($page);
1.327     albertel 8054: 	return;
1.318     albertel 8055:     }
                   8056:     return $page;
                   8057: }
1.347     albertel 8058: 
                   8059: {
1.610     albertel 8060:     my @row_count;
1.961     onken    8061: 
                   8062:     sub start_data_table_count {
                   8063:         unshift(@row_count, 0);
                   8064:         return;
                   8065:     }
                   8066: 
                   8067:     sub end_data_table_count {
                   8068:         shift(@row_count);
                   8069:         return;
                   8070:     }
                   8071: 
1.347     albertel 8072:     sub start_data_table {
1.1018    raeburn  8073: 	my ($add_class,$id) = @_;
1.422     albertel 8074: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8075:         my $table_id;
                   8076:         if (defined($id)) {
                   8077:             $table_id = ' id="'.$id.'"';
                   8078:         }
1.961     onken    8079: 	&start_data_table_count();
1.1018    raeburn  8080: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8081:     }
                   8082: 
                   8083:     sub end_data_table {
1.961     onken    8084: 	&end_data_table_count();
1.389     albertel 8085: 	return '</table>'."\n";;
1.347     albertel 8086:     }
                   8087: 
                   8088:     sub start_data_table_row {
1.974     wenzelju 8089: 	my ($add_class, $id) = @_;
1.610     albertel 8090: 	$row_count[0]++;
                   8091: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8092: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8093:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8094:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8095:     }
1.471     banghart 8096:     
                   8097:     sub continue_data_table_row {
1.974     wenzelju 8098: 	my ($add_class, $id) = @_;
1.610     albertel 8099: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8100: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8101:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8102:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8103:     }
1.347     albertel 8104: 
                   8105:     sub end_data_table_row {
1.389     albertel 8106: 	return '</tr>'."\n";;
1.347     albertel 8107:     }
1.367     www      8108: 
1.421     albertel 8109:     sub start_data_table_empty_row {
1.707     bisitz   8110: #	$row_count[0]++;
1.421     albertel 8111: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8112:     }
                   8113: 
                   8114:     sub end_data_table_empty_row {
                   8115: 	return '</tr>'."\n";;
                   8116:     }
                   8117: 
1.367     www      8118:     sub start_data_table_header_row {
1.389     albertel 8119: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8120:     }
                   8121: 
                   8122:     sub end_data_table_header_row {
1.389     albertel 8123: 	return '</tr>'."\n";;
1.367     www      8124:     }
1.890     droeschl 8125: 
                   8126:     sub data_table_caption {
                   8127:         my $caption = shift;
                   8128:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8129:     }
1.347     albertel 8130: }
                   8131: 
1.548     albertel 8132: =pod
                   8133: 
                   8134: =item * &inhibit_menu_check($arg)
                   8135: 
                   8136: Checks for a inhibitmenu state and generates output to preserve it
                   8137: 
                   8138: Inputs:         $arg - can be any of
                   8139:                      - undef - in which case the return value is a string 
                   8140:                                to add  into arguments list of a uri
                   8141:                      - 'input' - in which case the return value is a HTML
                   8142:                                  <form> <input> field of type hidden to
                   8143:                                  preserve the value
                   8144:                      - a url - in which case the return value is the url with
                   8145:                                the neccesary cgi args added to preserve the
                   8146:                                inhibitmenu state
                   8147:                      - a ref to a url - no return value, but the string is
                   8148:                                         updated to include the neccessary cgi
                   8149:                                         args to preserve the inhibitmenu state
                   8150: 
                   8151: =cut
                   8152: 
                   8153: sub inhibit_menu_check {
                   8154:     my ($arg) = @_;
                   8155:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8156:     if ($arg eq 'input') {
                   8157: 	if ($env{'form.inhibitmenu'}) {
                   8158: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8159: 	} else {
                   8160: 	    return
                   8161: 	}
                   8162:     }
                   8163:     if ($env{'form.inhibitmenu'}) {
                   8164: 	if (ref($arg)) {
                   8165: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8166: 	} elsif ($arg eq '') {
                   8167: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8168: 	} else {
                   8169: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8170: 	}
                   8171:     }
                   8172:     if (!ref($arg)) {
                   8173: 	return $arg;
                   8174:     }
                   8175: }
                   8176: 
1.251     albertel 8177: ###############################################
1.182     matthew  8178: 
                   8179: =pod
                   8180: 
1.549     albertel 8181: =back
                   8182: 
                   8183: =head1 User Information Routines
                   8184: 
                   8185: =over 4
                   8186: 
1.405     albertel 8187: =item * &get_users_function()
1.182     matthew  8188: 
                   8189: Used by &bodytag to determine the current users primary role.
                   8190: Returns either 'student','coordinator','admin', or 'author'.
                   8191: 
                   8192: =cut
                   8193: 
                   8194: ###############################################
                   8195: sub get_users_function {
1.815     tempelho 8196:     my $function = 'norole';
1.818     tempelho 8197:     if ($env{'request.role'}=~/^(st)/) {
                   8198:         $function='student';
                   8199:     }
1.907     raeburn  8200:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8201:         $function='coordinator';
                   8202:     }
1.258     albertel 8203:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8204:         $function='admin';
                   8205:     }
1.826     bisitz   8206:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8207:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8208:         $function='author';
                   8209:     }
                   8210:     return $function;
1.54      www      8211: }
1.99      www      8212: 
                   8213: ###############################################
                   8214: 
1.233     raeburn  8215: =pod
                   8216: 
1.821     raeburn  8217: =item * &show_course()
                   8218: 
                   8219: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8220: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8221: 
                   8222: Inputs:
                   8223: None
                   8224: 
                   8225: Outputs:
                   8226: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8227: 
                   8228: =cut
                   8229: 
                   8230: ###############################################
                   8231: sub show_course {
                   8232:     my $course = !$env{'user.adv'};
                   8233:     if (!$env{'user.adv'}) {
                   8234:         foreach my $env (keys(%env)) {
                   8235:             next if ($env !~ m/^user\.priv\./);
                   8236:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8237:                 $course = 0;
                   8238:                 last;
                   8239:             }
                   8240:         }
                   8241:     }
                   8242:     return $course;
                   8243: }
                   8244: 
                   8245: ###############################################
                   8246: 
                   8247: =pod
                   8248: 
1.542     raeburn  8249: =item * &check_user_status()
1.274     raeburn  8250: 
                   8251: Determines current status of supplied role for a
                   8252: specific user. Roles can be active, previous or future.
                   8253: 
                   8254: Inputs: 
                   8255: user's domain, user's username, course's domain,
1.375     raeburn  8256: course's number, optional section ID.
1.274     raeburn  8257: 
                   8258: Outputs:
                   8259: role status: active, previous or future. 
                   8260: 
                   8261: =cut
                   8262: 
                   8263: sub check_user_status {
1.412     raeburn  8264:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8265:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8266:     my @uroles = keys %userinfo;
                   8267:     my $srchstr;
                   8268:     my $active_chk = 'none';
1.412     raeburn  8269:     my $now = time;
1.274     raeburn  8270:     if (@uroles > 0) {
1.908     raeburn  8271:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8272:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8273:         } else {
1.412     raeburn  8274:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8275:         }
                   8276:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8277:             my $role_end = 0;
                   8278:             my $role_start = 0;
                   8279:             $active_chk = 'active';
1.412     raeburn  8280:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8281:                 $role_end = $1;
                   8282:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8283:                     $role_start = $1;
1.274     raeburn  8284:                 }
                   8285:             }
                   8286:             if ($role_start > 0) {
1.412     raeburn  8287:                 if ($now < $role_start) {
1.274     raeburn  8288:                     $active_chk = 'future';
                   8289:                 }
                   8290:             }
                   8291:             if ($role_end > 0) {
1.412     raeburn  8292:                 if ($now > $role_end) {
1.274     raeburn  8293:                     $active_chk = 'previous';
                   8294:                 }
                   8295:             }
                   8296:         }
                   8297:     }
                   8298:     return $active_chk;
                   8299: }
                   8300: 
                   8301: ###############################################
                   8302: 
                   8303: =pod
                   8304: 
1.405     albertel 8305: =item * &get_sections()
1.233     raeburn  8306: 
                   8307: Determines all the sections for a course including
                   8308: sections with students and sections containing other roles.
1.419     raeburn  8309: Incoming parameters: 
                   8310: 
                   8311: 1. domain
                   8312: 2. course number 
                   8313: 3. reference to array containing roles for which sections should 
                   8314: be gathered (optional).
                   8315: 4. reference to array containing status types for which sections 
                   8316: should be gathered (optional).
                   8317: 
                   8318: If the third argument is undefined, sections are gathered for any role. 
                   8319: If the fourth argument is undefined, sections are gathered for any status.
                   8320: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8321:  
1.374     raeburn  8322: Returns section hash (keys are section IDs, values are
                   8323: number of users in each section), subject to the
1.419     raeburn  8324: optional roles filter, optional status filter 
1.233     raeburn  8325: 
                   8326: =cut
                   8327: 
                   8328: ###############################################
                   8329: sub get_sections {
1.419     raeburn  8330:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8331:     if (!defined($cdom) || !defined($cnum)) {
                   8332:         my $cid =  $env{'request.course.id'};
                   8333: 
                   8334: 	return if (!defined($cid));
                   8335: 
                   8336:         $cdom = $env{'course.'.$cid.'.domain'};
                   8337:         $cnum = $env{'course.'.$cid.'.num'};
                   8338:     }
                   8339: 
                   8340:     my %sectioncount;
1.419     raeburn  8341:     my $now = time;
1.240     albertel 8342: 
1.1118    raeburn  8343:     my $check_students = 1;
                   8344:     my $only_students = 0;
                   8345:     if (ref($possible_roles) eq 'ARRAY') {
                   8346:         if (grep(/^st$/,@{$possible_roles})) {
                   8347:             if (@{$possible_roles} == 1) {
                   8348:                 $only_students = 1;
                   8349:             }
                   8350:         } else {
                   8351:             $check_students = 0;
                   8352:         }
                   8353:     }
                   8354: 
                   8355:     if ($check_students) { 
1.276     albertel 8356: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8357: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8358: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8359:         my $start_index = &Apache::loncoursedata::CL_START();
                   8360:         my $end_index = &Apache::loncoursedata::CL_END();
                   8361:         my $status;
1.366     albertel 8362: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8363: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8364: 				                     $data->[$status_index],
                   8365:                                                      $data->[$start_index],
                   8366:                                                      $data->[$end_index]);
                   8367:             if ($stu_status eq 'Active') {
                   8368:                 $status = 'active';
                   8369:             } elsif ($end < $now) {
                   8370:                 $status = 'previous';
                   8371:             } elsif ($start > $now) {
                   8372:                 $status = 'future';
                   8373:             } 
                   8374: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8375:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8376:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8377: 		    $sectioncount{$section}++;
                   8378:                 }
1.240     albertel 8379: 	    }
                   8380: 	}
                   8381:     }
1.1118    raeburn  8382:     if ($only_students) {
                   8383:         return %sectioncount;
                   8384:     }
1.240     albertel 8385:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8386:     foreach my $user (sort(keys(%courseroles))) {
                   8387: 	if ($user !~ /^(\w{2})/) { next; }
                   8388: 	my ($role) = ($user =~ /^(\w{2})/);
                   8389: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8390: 	my ($section,$status);
1.240     albertel 8391: 	if ($role eq 'cr' &&
                   8392: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8393: 	    $section=$1;
                   8394: 	}
                   8395: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8396: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8397:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8398:         if ($end == -1 && $start == -1) {
                   8399:             next; #deleted role
                   8400:         }
                   8401:         if (!defined($possible_status)) { 
                   8402:             $sectioncount{$section}++;
                   8403:         } else {
                   8404:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8405:                 $status = 'active';
                   8406:             } elsif ($end < $now) {
                   8407:                 $status = 'future';
                   8408:             } elsif ($start > $now) {
                   8409:                 $status = 'previous';
                   8410:             }
                   8411:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8412:                 $sectioncount{$section}++;
                   8413:             }
                   8414:         }
1.233     raeburn  8415:     }
1.366     albertel 8416:     return %sectioncount;
1.233     raeburn  8417: }
                   8418: 
1.274     raeburn  8419: ###############################################
1.294     raeburn  8420: 
                   8421: =pod
1.405     albertel 8422: 
                   8423: =item * &get_course_users()
                   8424: 
1.275     raeburn  8425: Retrieves usernames:domains for users in the specified course
                   8426: with specific role(s), and access status. 
                   8427: 
                   8428: Incoming parameters:
1.277     albertel 8429: 1. course domain
                   8430: 2. course number
                   8431: 3. access status: users must have - either active, 
1.275     raeburn  8432: previous, future, or all.
1.277     albertel 8433: 4. reference to array of permissible roles
1.288     raeburn  8434: 5. reference to array of section restrictions (optional)
                   8435: 6. reference to results object (hash of hashes).
                   8436: 7. reference to optional userdata hash
1.609     raeburn  8437: 8. reference to optional statushash
1.630     raeburn  8438: 9. flag if privileged users (except those set to unhide in
                   8439:    course settings) should be excluded    
1.609     raeburn  8440: Keys of top level results hash are roles.
1.275     raeburn  8441: Keys of inner hashes are username:domain, with 
                   8442: values set to access type.
1.288     raeburn  8443: Optional userdata hash returns an array with arguments in the 
                   8444: same order as loncoursedata::get_classlist() for student data.
                   8445: 
1.609     raeburn  8446: Optional statushash returns
                   8447: 
1.288     raeburn  8448: Entries for end, start, section and status are blank because
                   8449: of the possibility of multiple values for non-student roles.
                   8450: 
1.275     raeburn  8451: =cut
1.405     albertel 8452: 
1.275     raeburn  8453: ###############################################
1.405     albertel 8454: 
1.275     raeburn  8455: sub get_course_users {
1.630     raeburn  8456:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8457:     my %idx = ();
1.419     raeburn  8458:     my %seclists;
1.288     raeburn  8459: 
                   8460:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8461:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8462:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8463:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8464:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8465:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8466:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8467:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8468: 
1.290     albertel 8469:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8470:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8471:         my $now = time;
1.277     albertel 8472:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8473:             my $match = 0;
1.412     raeburn  8474:             my $secmatch = 0;
1.419     raeburn  8475:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8476:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8477:             if ($section eq '') {
                   8478:                 $section = 'none';
                   8479:             }
1.291     albertel 8480:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8481:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8482:                     $secmatch = 1;
                   8483:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8484:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8485:                         $secmatch = 1;
                   8486:                     }
                   8487:                 } else {  
1.419     raeburn  8488: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8489: 		        $secmatch = 1;
                   8490:                     }
1.290     albertel 8491: 		}
1.412     raeburn  8492:                 if (!$secmatch) {
                   8493:                     next;
                   8494:                 }
1.419     raeburn  8495:             }
1.275     raeburn  8496:             if (defined($$types{'active'})) {
1.288     raeburn  8497:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8498:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8499:                     $match = 1;
1.275     raeburn  8500:                 }
                   8501:             }
                   8502:             if (defined($$types{'previous'})) {
1.609     raeburn  8503:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8504:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8505:                     $match = 1;
1.275     raeburn  8506:                 }
                   8507:             }
                   8508:             if (defined($$types{'future'})) {
1.609     raeburn  8509:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8510:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8511:                     $match = 1;
1.275     raeburn  8512:                 }
                   8513:             }
1.609     raeburn  8514:             if ($match) {
                   8515:                 push(@{$seclists{$student}},$section);
                   8516:                 if (ref($userdata) eq 'HASH') {
                   8517:                     $$userdata{$student} = $$classlist{$student};
                   8518:                 }
                   8519:                 if (ref($statushash) eq 'HASH') {
                   8520:                     $statushash->{$student}{'st'}{$section} = $status;
                   8521:                 }
1.288     raeburn  8522:             }
1.275     raeburn  8523:         }
                   8524:     }
1.412     raeburn  8525:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8526:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8527:         my $now = time;
1.609     raeburn  8528:         my %displaystatus = ( previous => 'Expired',
                   8529:                               active   => 'Active',
                   8530:                               future   => 'Future',
                   8531:                             );
1.1121    raeburn  8532:         my (%nothide,@possdoms);
1.630     raeburn  8533:         if ($hidepriv) {
                   8534:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8535:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8536:                 if ($user !~ /:/) {
                   8537:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8538:                 } else {
                   8539:                     $nothide{$user} = 1;
                   8540:                 }
                   8541:             }
1.1121    raeburn  8542:             my @possdoms = ($cdom);
                   8543:             if ($coursehash{'checkforpriv'}) {
                   8544:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   8545:             }
1.630     raeburn  8546:         }
1.439     raeburn  8547:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8548:             my $match = 0;
1.412     raeburn  8549:             my $secmatch = 0;
1.439     raeburn  8550:             my $status;
1.412     raeburn  8551:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8552:             $user =~ s/:$//;
1.439     raeburn  8553:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8554:             if ($end == -1 || $start == -1) {
                   8555:                 next;
                   8556:             }
                   8557:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8558:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8559:                 my ($uname,$udom) = split(/:/,$user);
                   8560:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8561:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8562:                         $secmatch = 1;
                   8563:                     } elsif ($usec eq '') {
1.420     albertel 8564:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8565:                             $secmatch = 1;
                   8566:                         }
                   8567:                     } else {
                   8568:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8569:                             $secmatch = 1;
                   8570:                         }
                   8571:                     }
                   8572:                     if (!$secmatch) {
                   8573:                         next;
                   8574:                     }
1.288     raeburn  8575:                 }
1.419     raeburn  8576:                 if ($usec eq '') {
                   8577:                     $usec = 'none';
                   8578:                 }
1.275     raeburn  8579:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8580:                     if ($hidepriv) {
1.1121    raeburn  8581:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  8582:                             (!$nothide{$uname.':'.$udom})) {
                   8583:                             next;
                   8584:                         }
                   8585:                     }
1.503     raeburn  8586:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8587:                         $status = 'previous';
                   8588:                     } elsif ($start > $now) {
                   8589:                         $status = 'future';
                   8590:                     } else {
                   8591:                         $status = 'active';
                   8592:                     }
1.277     albertel 8593:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8594:                         if ($status eq $type) {
1.420     albertel 8595:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8596:                                 push(@{$$users{$role}{$user}},$type);
                   8597:                             }
1.288     raeburn  8598:                             $match = 1;
                   8599:                         }
                   8600:                     }
1.419     raeburn  8601:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8602:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8603: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8604:                         }
1.420     albertel 8605:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8606:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8607:                         }
1.609     raeburn  8608:                         if (ref($statushash) eq 'HASH') {
                   8609:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8610:                         }
1.275     raeburn  8611:                     }
                   8612:                 }
                   8613:             }
                   8614:         }
1.290     albertel 8615:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8616:             if ((defined($cdom)) && (defined($cnum))) {
                   8617:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8618:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8619:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8620:                     next if ($owner eq '');
                   8621:                     my ($ownername,$ownerdom);
                   8622:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8623:                         $ownername = $1;
                   8624:                         $ownerdom = $2;
                   8625:                     } else {
                   8626:                         $ownername = $owner;
                   8627:                         $ownerdom = $cdom;
                   8628:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8629:                     }
                   8630:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8631:                     if (defined($userdata) && 
1.609     raeburn  8632: 			!exists($$userdata{$owner})) {
                   8633: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8634:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8635:                             push(@{$seclists{$owner}},'none');
                   8636:                         }
                   8637:                         if (ref($statushash) eq 'HASH') {
                   8638:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8639:                         }
1.290     albertel 8640: 		    }
1.279     raeburn  8641:                 }
                   8642:             }
                   8643:         }
1.419     raeburn  8644:         foreach my $user (keys(%seclists)) {
                   8645:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8646:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8647:         }
1.275     raeburn  8648:     }
                   8649:     return;
                   8650: }
                   8651: 
1.288     raeburn  8652: sub get_user_info {
                   8653:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8654:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8655: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8656:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8657:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8658:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8659:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8660:     return;
                   8661: }
1.275     raeburn  8662: 
1.472     raeburn  8663: ###############################################
                   8664: 
                   8665: =pod
                   8666: 
                   8667: =item * &get_user_quota()
                   8668: 
1.1134    raeburn  8669: Retrieves quota assigned for storage of user files.
                   8670: Default is to report quota for portfolio files.
1.472     raeburn  8671: 
                   8672: Incoming parameters:
                   8673: 1. user's username
                   8674: 2. user's domain
1.1134    raeburn  8675: 3. quota name - portfolio, author, or course
1.1136    raeburn  8676:    (if no quota name provided, defaults to portfolio).
                   8677: 4. crstype - official, unofficial or community, if quota name is
                   8678:    course
1.472     raeburn  8679: 
                   8680: Returns:
1.536     raeburn  8681: 1. Disk quota (in Mb) assigned to student.
                   8682: 2. (Optional) Type of setting: custom or default
                   8683:    (individually assigned or default for user's 
                   8684:    institutional status).
                   8685: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8686:    or student - types as defined in localenroll::inst_usertypes 
                   8687:    for user's domain, which determines default quota for user.
                   8688: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8689: 
                   8690: If a value has been stored in the user's environment, 
1.536     raeburn  8691: it will return that, otherwise it returns the maximal default
1.1134    raeburn  8692: defined for the user's institutional status(es) in the domain.
1.472     raeburn  8693: 
                   8694: =cut
                   8695: 
                   8696: ###############################################
                   8697: 
                   8698: 
                   8699: sub get_user_quota {
1.1136    raeburn  8700:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  8701:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8702:     if (!defined($udom)) {
                   8703:         $udom = $env{'user.domain'};
                   8704:     }
                   8705:     if (!defined($uname)) {
                   8706:         $uname = $env{'user.name'};
                   8707:     }
                   8708:     if (($udom eq '' || $uname eq '') ||
                   8709:         ($udom eq 'public') && ($uname eq 'public')) {
                   8710:         $quota = 0;
1.536     raeburn  8711:         $quotatype = 'default';
                   8712:         $defquota = 0; 
1.472     raeburn  8713:     } else {
1.536     raeburn  8714:         my $inststatus;
1.1134    raeburn  8715:         if ($quotaname eq 'course') {
                   8716:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   8717:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   8718:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   8719:             } else {
                   8720:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   8721:                 $quota = $cenv{'internal.uploadquota'};
                   8722:             }
1.536     raeburn  8723:         } else {
1.1134    raeburn  8724:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8725:                 if ($quotaname eq 'author') {
                   8726:                     $quota = $env{'environment.authorquota'};
                   8727:                 } else {
                   8728:                     $quota = $env{'environment.portfolioquota'};
                   8729:                 }
                   8730:                 $inststatus = $env{'environment.inststatus'};
                   8731:             } else {
                   8732:                 my %userenv = 
                   8733:                     &Apache::lonnet::get('environment',['portfolioquota',
                   8734:                                          'authorquota','inststatus'],$udom,$uname);
                   8735:                 my ($tmp) = keys(%userenv);
                   8736:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8737:                     if ($quotaname eq 'author') {
                   8738:                         $quota = $userenv{'authorquota'};
                   8739:                     } else {
                   8740:                         $quota = $userenv{'portfolioquota'};
                   8741:                     }
                   8742:                     $inststatus = $userenv{'inststatus'};
                   8743:                 } else {
                   8744:                     undef(%userenv);
                   8745:                 }
                   8746:             }
                   8747:         }
                   8748:         if ($quota eq '' || wantarray) {
                   8749:             if ($quotaname eq 'course') {
                   8750:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1136    raeburn  8751:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || ($crstype eq 'community')) { 
                   8752:                     $defquota = $domdefs{$crstype.'quota'};
                   8753:                 }
                   8754:                 if ($defquota eq '') {
                   8755:                     $defquota = 500;
                   8756:                 }
1.1134    raeburn  8757:             } else {
                   8758:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   8759:             }
                   8760:             if ($quota eq '') {
                   8761:                 $quota = $defquota;
                   8762:                 $quotatype = 'default';
                   8763:             } else {
                   8764:                 $quotatype = 'custom';
                   8765:             }
1.472     raeburn  8766:         }
                   8767:     }
1.536     raeburn  8768:     if (wantarray) {
                   8769:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8770:     } else {
                   8771:         return $quota;
                   8772:     }
1.472     raeburn  8773: }
                   8774: 
                   8775: ###############################################
                   8776: 
                   8777: =pod
                   8778: 
                   8779: =item * &default_quota()
                   8780: 
1.536     raeburn  8781: Retrieves default quota assigned for storage of user portfolio files,
                   8782: given an (optional) user's institutional status.
1.472     raeburn  8783: 
                   8784: Incoming parameters:
1.1142    raeburn  8785: 
1.472     raeburn  8786: 1. domain
1.536     raeburn  8787: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8788:    status types (e.g., faculty, staff, student etc.)
                   8789:    which apply to the user for whom the default is being retrieved.
                   8790:    If the institutional status string in undefined, the domain
1.1134    raeburn  8791:    default quota will be returned.
                   8792: 3.  quota name - portfolio, author, or course
                   8793:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  8794: 
                   8795: Returns:
1.1142    raeburn  8796: 
1.472     raeburn  8797: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  8798: 2. (Optional) institutional type which determined the value of the
                   8799:    default quota.
1.472     raeburn  8800: 
                   8801: If a value has been stored in the domain's configuration db,
                   8802: it will return that, otherwise it returns 20 (for backwards 
                   8803: compatibility with domains which have not set up a configuration
                   8804: db file; the original statically defined portfolio quota was 20 Mb). 
                   8805: 
1.536     raeburn  8806: If the user's status includes multiple types (e.g., staff and student),
                   8807: the largest default quota which applies to the user determines the
                   8808: default quota returned.
                   8809: 
1.472     raeburn  8810: =cut
                   8811: 
                   8812: ###############################################
                   8813: 
                   8814: 
                   8815: sub default_quota {
1.1134    raeburn  8816:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  8817:     my ($defquota,$settingstatus);
                   8818:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8819:                                             ['quotas'],$udom);
1.1134    raeburn  8820:     my $key = 'defaultquota';
                   8821:     if ($quotaname eq 'author') {
                   8822:         $key = 'authorquota';
                   8823:     }
1.622     raeburn  8824:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8825:         if ($inststatus ne '') {
1.765     raeburn  8826:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8827:             foreach my $item (@statuses) {
1.1134    raeburn  8828:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8829:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  8830:                         if ($defquota eq '') {
1.1134    raeburn  8831:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8832:                             $settingstatus = $item;
1.1134    raeburn  8833:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   8834:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8835:                             $settingstatus = $item;
                   8836:                         }
                   8837:                     }
1.1134    raeburn  8838:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  8839:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8840:                         if ($defquota eq '') {
                   8841:                             $defquota = $quotahash{'quotas'}{$item};
                   8842:                             $settingstatus = $item;
                   8843:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8844:                             $defquota = $quotahash{'quotas'}{$item};
                   8845:                             $settingstatus = $item;
                   8846:                         }
1.536     raeburn  8847:                     }
                   8848:                 }
                   8849:             }
                   8850:         }
                   8851:         if ($defquota eq '') {
1.1134    raeburn  8852:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8853:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   8854:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  8855:                 $defquota = $quotahash{'quotas'}{'default'};
                   8856:             }
1.536     raeburn  8857:             $settingstatus = 'default';
1.1139    raeburn  8858:             if ($defquota eq '') {
                   8859:                 if ($quotaname eq 'author') {
                   8860:                     $defquota = 500;
                   8861:                 }
                   8862:             }
1.536     raeburn  8863:         }
                   8864:     } else {
                   8865:         $settingstatus = 'default';
1.1134    raeburn  8866:         if ($quotaname eq 'author') {
                   8867:             $defquota = 500;
                   8868:         } else {
                   8869:             $defquota = 20;
                   8870:         }
1.536     raeburn  8871:     }
                   8872:     if (wantarray) {
                   8873:         return ($defquota,$settingstatus);
1.472     raeburn  8874:     } else {
1.536     raeburn  8875:         return $defquota;
1.472     raeburn  8876:     }
                   8877: }
                   8878: 
1.1135    raeburn  8879: ###############################################
                   8880: 
                   8881: =pod
                   8882: 
1.1136    raeburn  8883: =item * &excess_filesize_warning()
1.1135    raeburn  8884: 
                   8885: Returns warning message if upload of file to authoring space, or copying
1.1136    raeburn  8886: of existing file within authoring space will cause quota for the authoring
                   8887: space to be exceeded,
                   8888: 
                   8889: Same, if upload of a file directly to a course/community via Course Editor
1.1137    raeburn  8890: will cause quota for uploaded content for the course to be exceeded.
1.1135    raeburn  8891: 
                   8892: Inputs: 6
1.1136    raeburn  8893: 1. username or coursenum
1.1135    raeburn  8894: 2. domain
1.1136    raeburn  8895: 3. context ('author' or 'course')
1.1135    raeburn  8896: 4. filename of file for which action is being requested
                   8897: 5. filesize (kB) of file
                   8898: 6. action being taken: copy or upload.
                   8899: 
                   8900: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142    raeburn  8901:          otherwise return null.
                   8902: 
                   8903: =back
1.1135    raeburn  8904: 
                   8905: =cut
                   8906: 
1.1136    raeburn  8907: sub excess_filesize_warning {
                   8908:     my ($uname,$udom,$context,$filename,$filesize,$action) = @_;
                   8909:     my $current_disk_usage = 0;
                   8910:     my $disk_quota = &get_user_quota($uname,$udom,$context); #expressed in MB
                   8911:     if ($context eq 'author') {
                   8912:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   8913:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   8914:     } else {
                   8915:         foreach my $subdir ('docs','supplemental') {
                   8916:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   8917:         }
                   8918:     }
1.1135    raeburn  8919:     $disk_quota = int($disk_quota * 1000);
                   8920:     if (($current_disk_usage + $filesize) > $disk_quota) {
                   8921:         return '<p><span class="LC_warning">'.
                   8922:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
                   8923:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</span>'.
                   8924:                '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   8925:                             $disk_quota,$current_disk_usage).
                   8926:                '</p>';
                   8927:     }
                   8928:     return;
                   8929: }
                   8930: 
                   8931: ###############################################
                   8932: 
                   8933: 
1.1136    raeburn  8934: 
                   8935: 
1.384     raeburn  8936: sub get_secgrprole_info {
                   8937:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8938:     my %sections_count = &get_sections($cdom,$cnum);
                   8939:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8940:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8941:     my @groups = sort(keys(%curr_groups));
                   8942:     my $allroles = [];
                   8943:     my $rolehash;
                   8944:     my $accesshash = {
                   8945:                      active => 'Currently has access',
                   8946:                      future => 'Will have future access',
                   8947:                      previous => 'Previously had access',
                   8948:                   };
                   8949:     if ($needroles) {
                   8950:         $rolehash = {'all' => 'all'};
1.385     albertel 8951:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8952: 	if (&Apache::lonnet::error(%user_roles)) {
                   8953: 	    undef(%user_roles);
                   8954: 	}
                   8955:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  8956:             my ($role)=split(/\:/,$item,2);
                   8957:             if ($role eq 'cr') { next; }
                   8958:             if ($role =~ /^cr/) {
                   8959:                 $$rolehash{$role} = (split('/',$role))[3];
                   8960:             } else {
                   8961:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   8962:             }
                   8963:         }
                   8964:         foreach my $key (sort(keys(%{$rolehash}))) {
                   8965:             push(@{$allroles},$key);
                   8966:         }
                   8967:         push (@{$allroles},'st');
                   8968:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   8969:     }
                   8970:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   8971: }
                   8972: 
1.555     raeburn  8973: sub user_picker {
1.994     raeburn  8974:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  8975:     my $currdom = $dom;
                   8976:     my %curr_selected = (
                   8977:                         srchin => 'dom',
1.580     raeburn  8978:                         srchby => 'lastname',
1.555     raeburn  8979:                       );
                   8980:     my $srchterm;
1.625     raeburn  8981:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  8982:         if ($srch->{'srchby'} ne '') {
                   8983:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   8984:         }
                   8985:         if ($srch->{'srchin'} ne '') {
                   8986:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   8987:         }
                   8988:         if ($srch->{'srchtype'} ne '') {
                   8989:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   8990:         }
                   8991:         if ($srch->{'srchdomain'} ne '') {
                   8992:             $currdom = $srch->{'srchdomain'};
                   8993:         }
                   8994:         $srchterm = $srch->{'srchterm'};
                   8995:     }
                   8996:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  8997:                     'usr'       => 'Search criteria',
1.563     raeburn  8998:                     'doma'      => 'Domain/institution to search',
1.558     albertel 8999:                     'uname'     => 'username',
                   9000:                     'lastname'  => 'last name',
1.555     raeburn  9001:                     'lastfirst' => 'last name, first name',
1.558     albertel 9002:                     'crs'       => 'in this course',
1.576     raeburn  9003:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9004:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9005:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9006:                     'exact'     => 'is',
                   9007:                     'contains'  => 'contains',
1.569     raeburn  9008:                     'begins'    => 'begins with',
1.571     raeburn  9009:                     'youm'      => "You must include some text to search for.",
                   9010:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9011:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9012:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9013:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9014:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9015:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9016:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9017:                                        );
1.563     raeburn  9018:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9019:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9020: 
                   9021:     my @srchins = ('crs','dom','alc','instd');
                   9022: 
                   9023:     foreach my $option (@srchins) {
                   9024:         # FIXME 'alc' option unavailable until 
                   9025:         #       loncreateuser::print_user_query_page()
                   9026:         #       has been completed.
                   9027:         next if ($option eq 'alc');
1.880     raeburn  9028:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9029:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9030:         if ($curr_selected{'srchin'} eq $option) {
                   9031:             $srchinsel .= ' 
                   9032:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9033:         } else {
                   9034:             $srchinsel .= '
                   9035:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9036:         }
1.555     raeburn  9037:     }
1.563     raeburn  9038:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9039: 
                   9040:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9041:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9042:         if ($curr_selected{'srchby'} eq $option) {
                   9043:             $srchbysel .= '
                   9044:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9045:         } else {
                   9046:             $srchbysel .= '
                   9047:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9048:          }
                   9049:     }
                   9050:     $srchbysel .= "\n  </select>\n";
                   9051: 
                   9052:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9053:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9054:         if ($curr_selected{'srchtype'} eq $option) {
                   9055:             $srchtypesel .= '
                   9056:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9057:         } else {
                   9058:             $srchtypesel .= '
                   9059:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9060:         }
                   9061:     }
                   9062:     $srchtypesel .= "\n  </select>\n";
                   9063: 
1.558     albertel 9064:     my ($newuserscript,$new_user_create);
1.994     raeburn  9065:     my $context_dom = $env{'request.role.domain'};
                   9066:     if ($context eq 'requestcrs') {
                   9067:         if ($env{'form.coursedom'} ne '') { 
                   9068:             $context_dom = $env{'form.coursedom'};
                   9069:         }
                   9070:     }
1.556     raeburn  9071:     if ($forcenewuser) {
1.576     raeburn  9072:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9073:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9074:                 if ($cancreate) {
                   9075:                     $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>';
                   9076:                 } else {
1.799     bisitz   9077:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9078:                     my %usertypetext = (
                   9079:                         official   => 'institutional',
                   9080:                         unofficial => 'non-institutional',
                   9081:                     );
1.799     bisitz   9082:                     $new_user_create = '<p class="LC_warning">'
                   9083:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9084:                                       .' '
                   9085:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9086:                                           ,'<a href="'.$helplink.'">','</a>')
                   9087:                                       .'</p><br />';
1.627     raeburn  9088:                 }
1.576     raeburn  9089:             }
                   9090:         }
                   9091: 
1.556     raeburn  9092:         $newuserscript = <<"ENDSCRIPT";
                   9093: 
1.570     raeburn  9094: function setSearch(createnew,callingForm) {
1.556     raeburn  9095:     if (createnew == 1) {
1.570     raeburn  9096:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9097:             if (callingForm.srchby.options[i].value == 'uname') {
                   9098:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9099:             }
                   9100:         }
1.570     raeburn  9101:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9102:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9103: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9104:             }
                   9105:         }
1.570     raeburn  9106:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9107:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9108:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9109:             }
                   9110:         }
1.570     raeburn  9111:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9112:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9113:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9114:             }
                   9115:         }
                   9116:     }
                   9117: }
                   9118: ENDSCRIPT
1.558     albertel 9119: 
1.556     raeburn  9120:     }
                   9121: 
1.555     raeburn  9122:     my $output = <<"END_BLOCK";
1.556     raeburn  9123: <script type="text/javascript">
1.824     bisitz   9124: // <![CDATA[
1.570     raeburn  9125: function validateEntry(callingForm) {
1.558     albertel 9126: 
1.556     raeburn  9127:     var checkok = 1;
1.558     albertel 9128:     var srchin;
1.570     raeburn  9129:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9130: 	if ( callingForm.srchin[i].checked ) {
                   9131: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9132: 	}
                   9133:     }
                   9134: 
1.570     raeburn  9135:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9136:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9137:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9138:     var srchterm =  callingForm.srchterm.value;
                   9139:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9140:     var msg = "";
                   9141: 
                   9142:     if (srchterm == "") {
                   9143:         checkok = 0;
1.571     raeburn  9144:         msg += "$lt{'youm'}\\n";
1.556     raeburn  9145:     }
                   9146: 
1.569     raeburn  9147:     if (srchtype== 'begins') {
                   9148:         if (srchterm.length < 2) {
                   9149:             checkok = 0;
1.571     raeburn  9150:             msg += "$lt{'thte'}\\n";
1.569     raeburn  9151:         }
                   9152:     }
                   9153: 
1.556     raeburn  9154:     if (srchtype== 'contains') {
                   9155:         if (srchterm.length < 3) {
                   9156:             checkok = 0;
1.571     raeburn  9157:             msg += "$lt{'thet'}\\n";
1.556     raeburn  9158:         }
                   9159:     }
                   9160:     if (srchin == 'instd') {
                   9161:         if (srchdomain == '') {
                   9162:             checkok = 0;
1.571     raeburn  9163:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  9164:         }
                   9165:     }
                   9166:     if (srchin == 'dom') {
                   9167:         if (srchdomain == '') {
                   9168:             checkok = 0;
1.571     raeburn  9169:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  9170:         }
                   9171:     }
                   9172:     if (srchby == 'lastfirst') {
                   9173:         if (srchterm.indexOf(",") == -1) {
                   9174:             checkok = 0;
1.571     raeburn  9175:             msg += "$lt{'whus'}\\n";
1.556     raeburn  9176:         }
                   9177:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9178:             checkok = 0;
1.571     raeburn  9179:             msg += "$lt{'whse'}\\n";
1.556     raeburn  9180:         }
                   9181:     }
                   9182:     if (checkok == 0) {
1.571     raeburn  9183:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  9184:         return;
                   9185:     }
                   9186:     if (checkok == 1) {
1.570     raeburn  9187:         callingForm.submit();
1.556     raeburn  9188:     }
                   9189: }
                   9190: 
                   9191: $newuserscript
                   9192: 
1.824     bisitz   9193: // ]]>
1.556     raeburn  9194: </script>
1.558     albertel 9195: 
                   9196: $new_user_create
                   9197: 
1.555     raeburn  9198: END_BLOCK
1.558     albertel 9199: 
1.876     raeburn  9200:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   9201:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   9202:                $domform.
                   9203:                &Apache::lonhtmlcommon::row_closure().
                   9204:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   9205:                $srchbysel.
                   9206:                $srchtypesel. 
                   9207:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9208:                $srchinsel.
                   9209:                &Apache::lonhtmlcommon::row_closure(1). 
                   9210:                &Apache::lonhtmlcommon::end_pick_box().
                   9211:                '<br />';
1.555     raeburn  9212:     return $output;
                   9213: }
                   9214: 
1.612     raeburn  9215: sub user_rule_check {
1.615     raeburn  9216:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  9217:     my $response;
                   9218:     if (ref($usershash) eq 'HASH') {
                   9219:         foreach my $user (keys(%{$usershash})) {
                   9220:             my ($uname,$udom) = split(/:/,$user);
                   9221:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  9222:             my ($id,$newuser);
1.612     raeburn  9223:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  9224:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  9225:                 $id = $usershash->{$user}->{'id'};
                   9226:             }
                   9227:             my $inst_response;
                   9228:             if (ref($checks) eq 'HASH') {
                   9229:                 if (defined($checks->{'username'})) {
1.615     raeburn  9230:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  9231:                         &Apache::lonnet::get_instuser($udom,$uname);
                   9232:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  9233:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  9234:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   9235:                 }
1.615     raeburn  9236:             } else {
                   9237:                 ($inst_response,%{$inst_results->{$user}}) =
                   9238:                     &Apache::lonnet::get_instuser($udom,$uname);
                   9239:                 return;
1.612     raeburn  9240:             }
1.615     raeburn  9241:             if (!$got_rules->{$udom}) {
1.612     raeburn  9242:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9243:                                                   ['usercreation'],$udom);
                   9244:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  9245:                     foreach my $item ('username','id') {
1.612     raeburn  9246:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9247:                             $$curr_rules{$udom}{$item} = 
                   9248:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  9249:                         }
                   9250:                     }
                   9251:                 }
1.615     raeburn  9252:                 $got_rules->{$udom} = 1;  
1.585     raeburn  9253:             }
1.612     raeburn  9254:             foreach my $item (keys(%{$checks})) {
                   9255:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9256:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9257:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   9258:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   9259:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9260:                                 if ($rule_check{$rule}) {
                   9261:                                     $$rulematch{$user}{$item} = $rule;
                   9262:                                     if ($inst_response eq 'ok') {
1.615     raeburn  9263:                                         if (ref($inst_results) eq 'HASH') {
                   9264:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9265:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9266:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   9267:                                                 }
1.612     raeburn  9268:                                             }
                   9269:                                         }
1.615     raeburn  9270:                                     }
                   9271:                                     last;
1.585     raeburn  9272:                                 }
                   9273:                             }
                   9274:                         }
                   9275:                     }
                   9276:                 }
                   9277:             }
                   9278:         }
                   9279:     }
1.612     raeburn  9280:     return;
                   9281: }
                   9282: 
                   9283: sub user_rule_formats {
                   9284:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9285:     my %text = ( 
                   9286:                  'username' => 'Usernames',
                   9287:                  'id'       => 'IDs',
                   9288:                );
                   9289:     my $output;
                   9290:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9291:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9292:         if (@{$ruleorder} > 0) {
1.1102    raeburn  9293:             $output = '<br />'.
                   9294:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9295:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9296:                       ' <ul>';
1.612     raeburn  9297:             foreach my $rule (@{$ruleorder}) {
                   9298:                 if (ref($curr_rules) eq 'ARRAY') {
                   9299:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9300:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9301:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9302:                                         $rules->{$rule}{'desc'}.'</li>';
                   9303:                         }
                   9304:                     }
                   9305:                 }
                   9306:             }
                   9307:             $output .= '</ul>';
                   9308:         }
                   9309:     }
                   9310:     return $output;
                   9311: }
                   9312: 
                   9313: sub instrule_disallow_msg {
1.615     raeburn  9314:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9315:     my $response;
                   9316:     my %text = (
                   9317:                   item   => 'username',
                   9318:                   items  => 'usernames',
                   9319:                   match  => 'matches',
                   9320:                   do     => 'does',
                   9321:                   action => 'a username',
                   9322:                   one    => 'one',
                   9323:                );
                   9324:     if ($count > 1) {
                   9325:         $text{'item'} = 'usernames';
                   9326:         $text{'match'} ='match';
                   9327:         $text{'do'} = 'do';
                   9328:         $text{'action'} = 'usernames',
                   9329:         $text{'one'} = 'ones';
                   9330:     }
                   9331:     if ($checkitem eq 'id') {
                   9332:         $text{'items'} = 'IDs';
                   9333:         $text{'item'} = 'ID';
                   9334:         $text{'action'} = 'an ID';
1.615     raeburn  9335:         if ($count > 1) {
                   9336:             $text{'item'} = 'IDs';
                   9337:             $text{'action'} = 'IDs';
                   9338:         }
1.612     raeburn  9339:     }
1.674     bisitz   9340:     $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  9341:     if ($mode eq 'upload') {
                   9342:         if ($checkitem eq 'username') {
                   9343:             $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'}.");
                   9344:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9345:             $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  9346:         }
1.669     raeburn  9347:     } elsif ($mode eq 'selfcreate') {
                   9348:         if ($checkitem eq 'id') {
                   9349:             $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.");
                   9350:         }
1.615     raeburn  9351:     } else {
                   9352:         if ($checkitem eq 'username') {
                   9353:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9354:         } elsif ($checkitem eq 'id') {
                   9355:             $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.");
                   9356:         }
1.612     raeburn  9357:     }
                   9358:     return $response;
1.585     raeburn  9359: }
                   9360: 
1.624     raeburn  9361: sub personal_data_fieldtitles {
                   9362:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9363:                         id => 'Student/Employee ID',
                   9364:                         permanentemail => 'E-mail address',
                   9365:                         lastname => 'Last Name',
                   9366:                         firstname => 'First Name',
                   9367:                         middlename => 'Middle Name',
                   9368:                         generation => 'Generation',
                   9369:                         gen => 'Generation',
1.765     raeburn  9370:                         inststatus => 'Affiliation',
1.624     raeburn  9371:                    );
                   9372:     return %fieldtitles;
                   9373: }
                   9374: 
1.642     raeburn  9375: sub sorted_inst_types {
                   9376:     my ($dom) = @_;
                   9377:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9378:     my $othertitle = &mt('All users');
                   9379:     if ($env{'request.course.id'}) {
1.668     raeburn  9380:         $othertitle  = &mt('Any users');
1.642     raeburn  9381:     }
                   9382:     my @types;
                   9383:     if (ref($order) eq 'ARRAY') {
                   9384:         @types = @{$order};
                   9385:     }
                   9386:     if (@types == 0) {
                   9387:         if (ref($usertypes) eq 'HASH') {
                   9388:             @types = sort(keys(%{$usertypes}));
                   9389:         }
                   9390:     }
                   9391:     if (keys(%{$usertypes}) > 0) {
                   9392:         $othertitle = &mt('Other users');
                   9393:     }
                   9394:     return ($othertitle,$usertypes,\@types);
                   9395: }
                   9396: 
1.645     raeburn  9397: sub get_institutional_codes {
                   9398:     my ($settings,$allcourses,$LC_code) = @_;
                   9399: # Get complete list of course sections to update
                   9400:     my @currsections = ();
                   9401:     my @currxlists = ();
                   9402:     my $coursecode = $$settings{'internal.coursecode'};
                   9403: 
                   9404:     if ($$settings{'internal.sectionnums'} ne '') {
                   9405:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9406:     }
                   9407: 
                   9408:     if ($$settings{'internal.crosslistings'} ne '') {
                   9409:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9410:     }
                   9411: 
                   9412:     if (@currxlists > 0) {
                   9413:         foreach (@currxlists) {
                   9414:             if (m/^([^:]+):(\w*)$/) {
                   9415:                 unless (grep/^$1$/,@{$allcourses}) {
                   9416:                     push @{$allcourses},$1;
                   9417:                     $$LC_code{$1} = $2;
                   9418:                 }
                   9419:             }
                   9420:         }
                   9421:     }
                   9422:  
                   9423:     if (@currsections > 0) {
                   9424:         foreach (@currsections) {
                   9425:             if (m/^(\w+):(\w*)$/) {
                   9426:                 my $sec = $coursecode.$1;
                   9427:                 my $lc_sec = $2;
                   9428:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9429:                     push @{$allcourses},$sec;
                   9430:                     $$LC_code{$sec} = $lc_sec;
                   9431:                 }
                   9432:             }
                   9433:         }
                   9434:     }
                   9435:     return;
                   9436: }
                   9437: 
1.971     raeburn  9438: sub get_standard_codeitems {
                   9439:     return ('Year','Semester','Department','Number','Section');
                   9440: }
                   9441: 
1.112     bowersj2 9442: =pod
                   9443: 
1.780     raeburn  9444: =head1 Slot Helpers
                   9445: 
                   9446: =over 4
                   9447: 
                   9448: =item * sorted_slots()
                   9449: 
1.1040    raeburn  9450: Sorts an array of slot names in order of an optional sort key,
                   9451: default sort is by slot start time (earliest first). 
1.780     raeburn  9452: 
                   9453: Inputs:
                   9454: 
                   9455: =over 4
                   9456: 
                   9457: slotsarr  - Reference to array of unsorted slot names.
                   9458: 
                   9459: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9460: 
1.1040    raeburn  9461: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9462: 
1.549     albertel 9463: =back
                   9464: 
1.780     raeburn  9465: Returns:
                   9466: 
                   9467: =over 4
                   9468: 
1.1040    raeburn  9469: sorted   - An array of slot names sorted by a specified sort key 
                   9470:            (default sort key is start time of the slot).
1.780     raeburn  9471: 
                   9472: =back
                   9473: 
                   9474: =cut
                   9475: 
                   9476: 
                   9477: sub sorted_slots {
1.1040    raeburn  9478:     my ($slotsarr,$slots,$sortkey) = @_;
                   9479:     if ($sortkey eq '') {
                   9480:         $sortkey = 'starttime';
                   9481:     }
1.780     raeburn  9482:     my @sorted;
                   9483:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9484:         @sorted =
                   9485:             sort {
                   9486:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9487:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9488:                      }
                   9489:                      if (ref($slots->{$a})) { return -1;}
                   9490:                      if (ref($slots->{$b})) { return 1;}
                   9491:                      return 0;
                   9492:                  } @{$slotsarr};
                   9493:     }
                   9494:     return @sorted;
                   9495: }
                   9496: 
1.1040    raeburn  9497: =pod
                   9498: 
                   9499: =item * get_future_slots()
                   9500: 
                   9501: Inputs:
                   9502: 
                   9503: =over 4
                   9504: 
                   9505: cnum - course number
                   9506: 
                   9507: cdom - course domain
                   9508: 
                   9509: now - current UNIX time
                   9510: 
                   9511: symb - optional symb
                   9512: 
                   9513: =back
                   9514: 
                   9515: Returns:
                   9516: 
                   9517: =over 4
                   9518: 
                   9519: sorted_reservable - ref to array of student_schedulable slots currently 
                   9520:                     reservable, ordered by end date of reservation period.
                   9521: 
                   9522: reservable_now - ref to hash of student_schedulable slots currently
                   9523:                  reservable.
                   9524: 
                   9525:     Keys in inner hash are:
                   9526:     (a) symb: either blank or symb to which slot use is restricted.
                   9527:     (b) endreserve: end date of reservation period. 
                   9528: 
                   9529: sorted_future - ref to array of student_schedulable slots reservable in
                   9530:                 the future, ordered by start date of reservation period.
                   9531: 
                   9532: future_reservable - ref to hash of student_schedulable slots reservable
                   9533:                     in the future.
                   9534: 
                   9535:     Keys in inner hash are:
                   9536:     (a) symb: either blank or symb to which slot use is restricted.
                   9537:     (b) startreserve:  start date of reservation period.
                   9538: 
                   9539: =back
                   9540: 
                   9541: =cut
                   9542: 
                   9543: sub get_future_slots {
                   9544:     my ($cnum,$cdom,$now,$symb) = @_;
                   9545:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9546:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9547:     foreach my $slot (keys(%slots)) {
                   9548:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9549:         if ($symb) {
                   9550:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9551:                      ($slots{$slot}->{'symb'} ne $symb));
                   9552:         }
                   9553:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9554:             ($slots{$slot}->{'endtime'} > $now)) {
                   9555:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9556:                 my $userallowed = 0;
                   9557:                 if ($slots{$slot}->{'allowedsections'}) {
                   9558:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9559:                     if (!defined($env{'request.role.sec'})
                   9560:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9561:                         $userallowed=1;
                   9562:                     } else {
                   9563:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9564:                             $userallowed=1;
                   9565:                         }
                   9566:                     }
                   9567:                     unless ($userallowed) {
                   9568:                         if (defined($env{'request.course.groups'})) {
                   9569:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9570:                             foreach my $group (@groups) {
                   9571:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9572:                                     $userallowed=1;
                   9573:                                     last;
                   9574:                                 }
                   9575:                             }
                   9576:                         }
                   9577:                     }
                   9578:                 }
                   9579:                 if ($slots{$slot}->{'allowedusers'}) {
                   9580:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9581:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9582:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9583:                         $userallowed = 1;
                   9584:                     }
                   9585:                 }
                   9586:                 next unless($userallowed);
                   9587:             }
                   9588:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9589:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9590:             my $symb = $slots{$slot}->{'symb'};
                   9591:             if (($startreserve < $now) &&
                   9592:                 (!$endreserve || $endreserve > $now)) {
                   9593:                 my $lastres = $endreserve;
                   9594:                 if (!$lastres) {
                   9595:                     $lastres = $slots{$slot}->{'starttime'};
                   9596:                 }
                   9597:                 $reservable_now{$slot} = {
                   9598:                                            symb       => $symb,
                   9599:                                            endreserve => $lastres
                   9600:                                          };
                   9601:             } elsif (($startreserve > $now) &&
                   9602:                      (!$endreserve || $endreserve > $startreserve)) {
                   9603:                 $future_reservable{$slot} = {
                   9604:                                               symb         => $symb,
                   9605:                                               startreserve => $startreserve
                   9606:                                             };
                   9607:             }
                   9608:         }
                   9609:     }
                   9610:     my @unsorted_reservable = keys(%reservable_now);
                   9611:     if (@unsorted_reservable > 0) {
                   9612:         @sorted_reservable = 
                   9613:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9614:     }
                   9615:     my @unsorted_future = keys(%future_reservable);
                   9616:     if (@unsorted_future > 0) {
                   9617:         @sorted_future =
                   9618:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9619:     }
                   9620:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9621: }
1.780     raeburn  9622: 
                   9623: =pod
                   9624: 
1.1057    foxr     9625: =back
                   9626: 
1.549     albertel 9627: =head1 HTTP Helpers
                   9628: 
                   9629: =over 4
                   9630: 
1.648     raeburn  9631: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9632: 
1.258     albertel 9633: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9634: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9635: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9636: 
                   9637: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9638: $possible_names is an ref to an array of form element names.  As an example:
                   9639: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9640: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9641: 
                   9642: =cut
1.1       albertel 9643: 
1.6       albertel 9644: sub get_unprocessed_cgi {
1.25      albertel 9645:   my ($query,$possible_names)= @_;
1.26      matthew  9646:   # $Apache::lonxml::debug=1;
1.356     albertel 9647:   foreach my $pair (split(/&/,$query)) {
                   9648:     my ($name, $value) = split(/=/,$pair);
1.369     www      9649:     $name = &unescape($name);
1.25      albertel 9650:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9651:       $value =~ tr/+/ /;
                   9652:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9653:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9654:     }
1.16      harris41 9655:   }
1.6       albertel 9656: }
                   9657: 
1.112     bowersj2 9658: =pod
                   9659: 
1.648     raeburn  9660: =item * &cacheheader() 
1.112     bowersj2 9661: 
                   9662: returns cache-controlling header code
                   9663: 
                   9664: =cut
                   9665: 
1.7       albertel 9666: sub cacheheader {
1.258     albertel 9667:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9668:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9669:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9670:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9671:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9672:     return $output;
1.7       albertel 9673: }
                   9674: 
1.112     bowersj2 9675: =pod
                   9676: 
1.648     raeburn  9677: =item * &no_cache($r) 
1.112     bowersj2 9678: 
                   9679: specifies header code to not have cache
                   9680: 
                   9681: =cut
                   9682: 
1.9       albertel 9683: sub no_cache {
1.216     albertel 9684:     my ($r) = @_;
                   9685:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9686: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9687:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9688:     $r->no_cache(1);
                   9689:     $r->header_out("Expires" => $date);
                   9690:     $r->header_out("Pragma" => "no-cache");
1.123     www      9691: }
                   9692: 
                   9693: sub content_type {
1.181     albertel 9694:     my ($r,$type,$charset) = @_;
1.299     foxr     9695:     if ($r) {
                   9696: 	#  Note that printout.pl calls this with undef for $r.
                   9697: 	&no_cache($r);
                   9698:     }
1.258     albertel 9699:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9700:     unless ($charset) {
                   9701: 	$charset=&Apache::lonlocal::current_encoding;
                   9702:     }
                   9703:     if ($charset) { $type.='; charset='.$charset; }
                   9704:     if ($r) {
                   9705: 	$r->content_type($type);
                   9706:     } else {
                   9707: 	print("Content-type: $type\n\n");
                   9708:     }
1.9       albertel 9709: }
1.25      albertel 9710: 
1.112     bowersj2 9711: =pod
                   9712: 
1.648     raeburn  9713: =item * &add_to_env($name,$value) 
1.112     bowersj2 9714: 
1.258     albertel 9715: adds $name to the %env hash with value
1.112     bowersj2 9716: $value, if $name already exists, the entry is converted to an array
                   9717: reference and $value is added to the array.
                   9718: 
                   9719: =cut
                   9720: 
1.25      albertel 9721: sub add_to_env {
                   9722:   my ($name,$value)=@_;
1.258     albertel 9723:   if (defined($env{$name})) {
                   9724:     if (ref($env{$name})) {
1.25      albertel 9725:       #already have multiple values
1.258     albertel 9726:       push(@{ $env{$name} },$value);
1.25      albertel 9727:     } else {
                   9728:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9729:       my $first=$env{$name};
                   9730:       undef($env{$name});
                   9731:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9732:     }
                   9733:   } else {
1.258     albertel 9734:     $env{$name}=$value;
1.25      albertel 9735:   }
1.31      albertel 9736: }
1.149     albertel 9737: 
                   9738: =pod
                   9739: 
1.648     raeburn  9740: =item * &get_env_multiple($name) 
1.149     albertel 9741: 
1.258     albertel 9742: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9743: values may be defined and end up as an array ref.
                   9744: 
                   9745: returns an array of values
                   9746: 
                   9747: =cut
                   9748: 
                   9749: sub get_env_multiple {
                   9750:     my ($name) = @_;
                   9751:     my @values;
1.258     albertel 9752:     if (defined($env{$name})) {
1.149     albertel 9753:         # exists is it an array
1.258     albertel 9754:         if (ref($env{$name})) {
                   9755:             @values=@{ $env{$name} };
1.149     albertel 9756:         } else {
1.258     albertel 9757:             $values[0]=$env{$name};
1.149     albertel 9758:         }
                   9759:     }
                   9760:     return(@values);
                   9761: }
                   9762: 
1.660     raeburn  9763: sub ask_for_embedded_content {
                   9764:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9765:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  9766:         %currsubfile,%unused,$rem);
1.1071    raeburn  9767:     my $counter = 0;
                   9768:     my $numnew = 0;
1.987     raeburn  9769:     my $numremref = 0;
                   9770:     my $numinvalid = 0;
                   9771:     my $numpathchg = 0;
                   9772:     my $numexisting = 0;
1.1071    raeburn  9773:     my $numunused = 0;
                   9774:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
                   9775:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
                   9776:     my $heading = &mt('Upload embedded files');
                   9777:     my $buttontext = &mt('Upload');
                   9778: 
1.1123    raeburn  9779:     my ($navmap,$cdom,$cnum);
1.1085    raeburn  9780:     if ($env{'request.course.id'}) {
1.1123    raeburn  9781:         if ($actionurl eq '/adm/dependencies') {
                   9782:             $navmap = Apache::lonnavmaps::navmap->new();
                   9783:         }
                   9784:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9785:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085    raeburn  9786:     }
1.1123    raeburn  9787:     if (($actionurl eq '/adm/portfolio') || 
                   9788:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  9789:         my $current_path='/';
                   9790:         if ($env{'form.currentpath'}) {
                   9791:             $current_path = $env{'form.currentpath'};
                   9792:         }
                   9793:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123    raeburn  9794:             $udom = $cdom;
                   9795:             $uname = $cnum;
1.984     raeburn  9796:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9797:         } else {
                   9798:             $udom = $env{'user.domain'};
                   9799:             $uname = $env{'user.name'};
                   9800:             $url = '/userfiles/portfolio';
                   9801:         }
1.987     raeburn  9802:         $toplevel = $url.'/';
1.984     raeburn  9803:         $url .= $current_path;
                   9804:         $getpropath = 1;
1.987     raeburn  9805:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9806:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9807:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9808:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9809:         $toplevel = $url;
1.984     raeburn  9810:         if ($rest ne '') {
1.987     raeburn  9811:             $url .= $rest;
                   9812:         }
                   9813:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9814:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9815:             $url = $args->{'docs_url'};
                   9816:             $toplevel = $url;
1.1084    raeburn  9817:             if ($args->{'context'} eq 'paste') {
                   9818:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9819:                 ($path) = 
                   9820:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9821:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9822:                 $fileloc =~ s{^/}{};
                   9823:             }
1.1071    raeburn  9824:         }
1.1084    raeburn  9825:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  9826:         if ($env{'request.course.id'} ne '') {
                   9827:             if (ref($args) eq 'HASH') {
                   9828:                 $url = $args->{'docs_url'};
                   9829:                 $title = $args->{'docs_title'};
1.1126    raeburn  9830:                 $toplevel = $url; 
                   9831:                 unless ($toplevel =~ m{^/}) {
                   9832:                     $toplevel = "/$url";
                   9833:                 }
1.1085    raeburn  9834:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126    raeburn  9835:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   9836:                     $path = $1;
                   9837:                 } else {
                   9838:                     ($path) =
                   9839:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9840:                 }
1.1071    raeburn  9841:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9842:                 $fileloc =~ s{^/}{};
                   9843:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9844:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9845:             }
1.987     raeburn  9846:         }
1.1123    raeburn  9847:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9848:         $udom = $cdom;
                   9849:         $uname = $cnum;
                   9850:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   9851:         $toplevel = $url;
                   9852:         $path = $url;
                   9853:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   9854:         $fileloc =~ s{^/}{};
1.987     raeburn  9855:     }
1.1126    raeburn  9856:     foreach my $file (keys(%{$allfiles})) {
                   9857:         my $embed_file;
                   9858:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   9859:             $embed_file = $1;
                   9860:         } else {
                   9861:             $embed_file = $file;
                   9862:         }
1.987     raeburn  9863:         my $absolutepath;
                   9864:         if ($embed_file =~ m{^\w+://}) {
                   9865:             $newfiles{$embed_file} = 1;
                   9866:             $mapping{$embed_file} = $embed_file;
                   9867:         } else {
                   9868:             if ($embed_file =~ m{^/}) {
                   9869:                 $absolutepath = $embed_file;
                   9870:                 $embed_file =~ s{^(/+)}{};
                   9871:             }
                   9872:             if ($embed_file =~ m{/}) {
                   9873:                 my ($path,$fname) = ($embed_file =~ m{^(.+)/([^/]*)$});
                   9874:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9875:                 my $item = $fname;
                   9876:                 if ($path ne '') {
                   9877:                     $item = $path.'/'.$fname;
                   9878:                     $subdependencies{$path}{$fname} = 1;
                   9879:                 } else {
                   9880:                     $dependencies{$item} = 1;
                   9881:                 }
                   9882:                 if ($absolutepath) {
                   9883:                     $mapping{$item} = $absolutepath;
                   9884:                 } else {
                   9885:                     $mapping{$item} = $embed_file;
                   9886:                 }
                   9887:             } else {
                   9888:                 $dependencies{$embed_file} = 1;
                   9889:                 if ($absolutepath) {
                   9890:                     $mapping{$embed_file} = $absolutepath;
                   9891:                 } else {
                   9892:                     $mapping{$embed_file} = $embed_file;
                   9893:                 }
                   9894:             }
1.984     raeburn  9895:         }
                   9896:     }
1.1071    raeburn  9897:     my $dirptr = 16384;
1.984     raeburn  9898:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9899:         $currsubfile{$path} = {};
1.1123    raeburn  9900:         if (($actionurl eq '/adm/portfolio') || 
                   9901:             ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9902:             my ($sublistref,$listerror) =
                   9903:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9904:             if (ref($sublistref) eq 'ARRAY') {
                   9905:                 foreach my $line (@{$sublistref}) {
                   9906:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9907:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9908:                 }
1.984     raeburn  9909:             }
1.987     raeburn  9910:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9911:             if (opendir(my $dir,$url.'/'.$path)) {
                   9912:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9913:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9914:             }
1.1084    raeburn  9915:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9916:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  9917:                   ($args->{'context'} eq 'paste')) ||
                   9918:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  9919:             if ($env{'request.course.id'} ne '') {
1.1123    raeburn  9920:                 my $dir;
                   9921:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9922:                     $dir = $fileloc;
                   9923:                 } else {
                   9924:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9925:                 }
1.1071    raeburn  9926:                 if ($dir ne '') {
                   9927:                     my ($sublistref,$listerror) =
                   9928:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9929:                     if (ref($sublistref) eq 'ARRAY') {
                   9930:                         foreach my $line (@{$sublistref}) {
                   9931:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9932:                                 undef,$mtime)=split(/\&/,$line,12);
                   9933:                             unless (($testdir&$dirptr) ||
                   9934:                                     ($file_name =~ /^\.\.?$/)) {
                   9935:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9936:                             }
                   9937:                         }
                   9938:                     }
                   9939:                 }
1.984     raeburn  9940:             }
                   9941:         }
                   9942:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  9943:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  9944:                 my $item = $path.'/'.$file;
                   9945:                 unless ($mapping{$item} eq $item) {
                   9946:                     $pathchanges{$item} = 1;
                   9947:                 }
                   9948:                 $existing{$item} = 1;
                   9949:                 $numexisting ++;
                   9950:             } else {
                   9951:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  9952:             }
                   9953:         }
1.1071    raeburn  9954:         if ($actionurl eq '/adm/dependencies') {
                   9955:             foreach my $path (keys(%currsubfile)) {
                   9956:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   9957:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   9958:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  9959:                              next if (($rem ne '') &&
                   9960:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   9961:                                        (ref($navmap) &&
                   9962:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   9963:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9964:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  9965:                              $unused{$path.'/'.$file} = 1; 
                   9966:                          }
                   9967:                     }
                   9968:                 }
                   9969:             }
                   9970:         }
1.984     raeburn  9971:     }
1.987     raeburn  9972:     my %currfile;
1.1123    raeburn  9973:     if (($actionurl eq '/adm/portfolio') ||
                   9974:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9975:         my ($dirlistref,$listerror) =
                   9976:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   9977:         if (ref($dirlistref) eq 'ARRAY') {
                   9978:             foreach my $line (@{$dirlistref}) {
                   9979:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   9980:                 $currfile{$file_name} = 1;
                   9981:             }
1.984     raeburn  9982:         }
1.987     raeburn  9983:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9984:         if (opendir(my $dir,$url)) {
1.987     raeburn  9985:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  9986:             map {$currfile{$_} = 1;} @dir_list;
                   9987:         }
1.1084    raeburn  9988:     } elsif (($actionurl eq '/adm/dependencies') ||
                   9989:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  9990:               ($args->{'context'} eq 'paste')) ||
                   9991:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  9992:         if ($env{'request.course.id'} ne '') {
                   9993:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9994:             if ($dir ne '') {
                   9995:                 my ($dirlistref,$listerror) =
                   9996:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   9997:                 if (ref($dirlistref) eq 'ARRAY') {
                   9998:                     foreach my $line (@{$dirlistref}) {
                   9999:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10000:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10001:                         unless (($testdir&$dirptr) ||
                   10002:                                 ($file_name =~ /^\.\.?$/)) {
                   10003:                             $currfile{$file_name} = [$size,$mtime];
                   10004:                         }
                   10005:                     }
                   10006:                 }
                   10007:             }
                   10008:         }
1.984     raeburn  10009:     }
                   10010:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10011:         if (exists($currfile{$file})) {
1.987     raeburn  10012:             unless ($mapping{$file} eq $file) {
                   10013:                 $pathchanges{$file} = 1;
                   10014:             }
                   10015:             $existing{$file} = 1;
                   10016:             $numexisting ++;
                   10017:         } else {
1.984     raeburn  10018:             $newfiles{$file} = 1;
                   10019:         }
                   10020:     }
1.1071    raeburn  10021:     foreach my $file (keys(%currfile)) {
                   10022:         unless (($file eq $filename) ||
                   10023:                 ($file eq $filename.'.bak') ||
                   10024:                 ($dependencies{$file})) {
1.1085    raeburn  10025:             if ($actionurl eq '/adm/dependencies') {
1.1126    raeburn  10026:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10027:                     next if (($rem ne '') &&
                   10028:                              (($env{"httpref.$rem".$file} ne '') ||
                   10029:                               (ref($navmap) &&
                   10030:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10031:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10032:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10033:                 }
1.1085    raeburn  10034:             }
1.1071    raeburn  10035:             $unused{$file} = 1;
                   10036:         }
                   10037:     }
1.1084    raeburn  10038:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10039:         ($args->{'context'} eq 'paste')) {
                   10040:         $counter = scalar(keys(%existing));
                   10041:         $numpathchg = scalar(keys(%pathchanges));
1.1123    raeburn  10042:         return ($output,$counter,$numpathchg,\%existing);
                   10043:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
                   10044:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10045:         $counter = scalar(keys(%existing));
                   10046:         $numpathchg = scalar(keys(%pathchanges));
                   10047:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084    raeburn  10048:     }
1.984     raeburn  10049:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10050:         if ($actionurl eq '/adm/dependencies') {
                   10051:             next if ($embed_file =~ m{^\w+://});
                   10052:         }
1.660     raeburn  10053:         $upload_output .= &start_data_table_row().
1.1123    raeburn  10054:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10055:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10056:         unless ($mapping{$embed_file} eq $embed_file) {
1.1123    raeburn  10057:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10058:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10059:         }
1.1123    raeburn  10060:         $upload_output .= '</td>';
1.1071    raeburn  10061:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1123    raeburn  10062:             $upload_output.='<td align="right">'.
                   10063:                             '<span class="LC_info LC_fontsize_medium">'.
                   10064:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10065:             $numremref++;
1.660     raeburn  10066:         } elsif ($args->{'error_on_invalid_names'}
                   10067:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123    raeburn  10068:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10069:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10070:             $numinvalid++;
1.660     raeburn  10071:         } else {
1.1123    raeburn  10072:             $upload_output .= '<td>'.
                   10073:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10074:                                                      $embed_file,\%mapping,
1.1071    raeburn  10075:                                                      $allfiles,$codebase,'upload');
                   10076:             $counter ++;
                   10077:             $numnew ++;
1.987     raeburn  10078:         }
                   10079:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10080:     }
                   10081:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10082:         if ($actionurl eq '/adm/dependencies') {
                   10083:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10084:             $modify_output .= &start_data_table_row().
                   10085:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10086:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10087:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10088:                               '<td>'.$size.'</td>'.
                   10089:                               '<td>'.$mtime.'</td>'.
                   10090:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10091:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10092:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10093:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10094:                               &embedded_file_element('upload_embedded',$counter,
                   10095:                                                      $embed_file,\%mapping,
                   10096:                                                      $allfiles,$codebase,'modify').
                   10097:                               '</div></td>'.
                   10098:                               &end_data_table_row()."\n";
                   10099:             $counter ++;
                   10100:         } else {
                   10101:             $upload_output .= &start_data_table_row().
1.1123    raeburn  10102:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10103:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10104:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10105:                               &Apache::loncommon::end_data_table_row()."\n";
                   10106:         }
                   10107:     }
                   10108:     my $delidx = $counter;
                   10109:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10110:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10111:         $delete_output .= &start_data_table_row().
                   10112:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10113:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10114:                           '<td>'.$size.'</td>'.
                   10115:                           '<td>'.$mtime.'</td>'.
                   10116:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10117:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10118:                           &embedded_file_element('upload_embedded',$delidx,
                   10119:                                                  $oldfile,\%mapping,$allfiles,
                   10120:                                                  $codebase,'delete').'</td>'.
                   10121:                           &end_data_table_row()."\n"; 
                   10122:         $numunused ++;
                   10123:         $delidx ++;
1.987     raeburn  10124:     }
                   10125:     if ($upload_output) {
                   10126:         $upload_output = &start_data_table().
                   10127:                          $upload_output.
                   10128:                          &end_data_table()."\n";
                   10129:     }
1.1071    raeburn  10130:     if ($modify_output) {
                   10131:         $modify_output = &start_data_table().
                   10132:                          &start_data_table_header_row().
                   10133:                          '<th>'.&mt('File').'</th>'.
                   10134:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10135:                          '<th>'.&mt('Modified').'</th>'.
                   10136:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10137:                          &end_data_table_header_row().
                   10138:                          $modify_output.
                   10139:                          &end_data_table()."\n";
                   10140:     }
                   10141:     if ($delete_output) {
                   10142:         $delete_output = &start_data_table().
                   10143:                          &start_data_table_header_row().
                   10144:                          '<th>'.&mt('File').'</th>'.
                   10145:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10146:                          '<th>'.&mt('Modified').'</th>'.
                   10147:                          '<th>'.&mt('Delete?').'</th>'.
                   10148:                          &end_data_table_header_row().
                   10149:                          $delete_output.
                   10150:                          &end_data_table()."\n";
                   10151:     }
1.987     raeburn  10152:     my $applies = 0;
                   10153:     if ($numremref) {
                   10154:         $applies ++;
                   10155:     }
                   10156:     if ($numinvalid) {
                   10157:         $applies ++;
                   10158:     }
                   10159:     if ($numexisting) {
                   10160:         $applies ++;
                   10161:     }
1.1071    raeburn  10162:     if ($counter || $numunused) {
1.987     raeburn  10163:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10164:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10165:                   $state.'<h3>'.$heading.'</h3>'; 
                   10166:         if ($actionurl eq '/adm/dependencies') {
                   10167:             if ($numnew) {
                   10168:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10169:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10170:                            $upload_output.'<br />'."\n";
                   10171:             }
                   10172:             if ($numexisting) {
                   10173:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10174:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10175:                            $modify_output.'<br />'."\n";
                   10176:                            $buttontext = &mt('Save changes');
                   10177:             }
                   10178:             if ($numunused) {
                   10179:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10180:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10181:                            $delete_output.'<br />'."\n";
                   10182:                            $buttontext = &mt('Save changes');
                   10183:             }
                   10184:         } else {
                   10185:             $output .= $upload_output.'<br />'."\n";
                   10186:         }
                   10187:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10188:                    $counter.'" />'."\n";
                   10189:         if ($actionurl eq '/adm/dependencies') { 
                   10190:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10191:                        $numnew.'" />'."\n";
                   10192:         } elsif ($actionurl eq '') {
1.987     raeburn  10193:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10194:         }
                   10195:     } elsif ($applies) {
                   10196:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10197:         if ($applies > 1) {
                   10198:             $output .=  
1.1123    raeburn  10199:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10200:             if ($numremref) {
                   10201:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10202:             }
                   10203:             if ($numinvalid) {
                   10204:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10205:             }
                   10206:             if ($numexisting) {
                   10207:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10208:             }
                   10209:             $output .= '</ul><br />';
                   10210:         } elsif ($numremref) {
                   10211:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10212:         } elsif ($numinvalid) {
                   10213:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10214:         } elsif ($numexisting) {
                   10215:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10216:         }
                   10217:         $output .= $upload_output.'<br />';
                   10218:     }
                   10219:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10220:     $chgcount = $counter;
1.987     raeburn  10221:     if (keys(%pathchanges) > 0) {
                   10222:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10223:             if ($counter) {
1.987     raeburn  10224:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10225:                                                   $embed_file,\%mapping,
1.1071    raeburn  10226:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10227:             } else {
                   10228:                 $pathchange_output .= 
                   10229:                     &start_data_table_row().
                   10230:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10231:                     $chgcount.'" checked="checked" /></td>'.
                   10232:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10233:                     '<td>'.$embed_file.
                   10234:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10235:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10236:                     '</td>'.&end_data_table_row();
1.660     raeburn  10237:             }
1.987     raeburn  10238:             $numpathchg ++;
                   10239:             $chgcount ++;
1.660     raeburn  10240:         }
                   10241:     }
1.1127    raeburn  10242:     if (($counter) || ($numunused)) {
1.987     raeburn  10243:         if ($numpathchg) {
                   10244:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10245:                        $numpathchg.'" />'."\n";
                   10246:         }
                   10247:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10248:             ($actionurl eq '/adm/imsimport')) {
                   10249:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10250:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10251:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10252:         } elsif ($actionurl eq '/adm/dependencies') {
                   10253:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10254:         }
1.1123    raeburn  10255:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10256:     } elsif ($numpathchg) {
                   10257:         my %pathchange = ();
                   10258:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10259:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10260:             $output .= '<p>'.&mt('or').'</p>'; 
1.1123    raeburn  10261:         }
1.987     raeburn  10262:     }
1.1071    raeburn  10263:     return ($output,$counter,$numpathchg);
1.987     raeburn  10264: }
                   10265: 
                   10266: sub embedded_file_element {
1.1071    raeburn  10267:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10268:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10269:                    (ref($codebase) eq 'HASH'));
                   10270:     my $output;
1.1071    raeburn  10271:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10272:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10273:     }
                   10274:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10275:                &escape($embed_file).'" />';
                   10276:     unless (($context eq 'upload_embedded') && 
                   10277:             ($mapping->{$embed_file} eq $embed_file)) {
                   10278:         $output .='
                   10279:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10280:     }
                   10281:     my $attrib;
                   10282:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10283:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10284:     }
                   10285:     $output .=
                   10286:         "\n\t\t".
                   10287:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10288:         $attrib.'" />';
                   10289:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10290:         $output .=
                   10291:             "\n\t\t".
                   10292:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10293:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10294:     }
1.987     raeburn  10295:     return $output;
1.660     raeburn  10296: }
                   10297: 
1.1071    raeburn  10298: sub get_dependency_details {
                   10299:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10300:     my ($size,$mtime,$showsize,$showmtime);
                   10301:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10302:         if ($embed_file =~ m{/}) {
                   10303:             my ($path,$fname) = split(/\//,$embed_file);
                   10304:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10305:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10306:             }
                   10307:         } else {
                   10308:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10309:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10310:             }
                   10311:         }
                   10312:         $showsize = $size/1024.0;
                   10313:         $showsize = sprintf("%.1f",$showsize);
                   10314:         if ($mtime > 0) {
                   10315:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10316:         }
                   10317:     }
                   10318:     return ($showsize,$showmtime);
                   10319: }
                   10320: 
                   10321: sub ask_embedded_js {
                   10322:     return <<"END";
                   10323: <script type="text/javascript"">
                   10324: // <![CDATA[
                   10325: function toggleBrowse(counter) {
                   10326:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10327:     var fileid = document.getElementById('embedded_item_'+counter);
                   10328:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10329:     if (chkboxid.checked == true) {
                   10330:         uploaddivid.style.display='block';
                   10331:     } else {
                   10332:         uploaddivid.style.display='none';
                   10333:         fileid.value = '';
                   10334:     }
                   10335: }
                   10336: // ]]>
                   10337: </script>
                   10338: 
                   10339: END
                   10340: }
                   10341: 
1.661     raeburn  10342: sub upload_embedded {
                   10343:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10344:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10345:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10346:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10347:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10348:         my $orig_uploaded_filename =
                   10349:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10350:         foreach my $type ('orig','ref','attrib','codebase') {
                   10351:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10352:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10353:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10354:             }
                   10355:         }
1.661     raeburn  10356:         my ($path,$fname) =
                   10357:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10358:         # no path, whole string is fname
                   10359:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10360:         $fname = &Apache::lonnet::clean_filename($fname);
                   10361:         # See if there is anything left
                   10362:         next if ($fname eq '');
                   10363: 
                   10364:         # Check if file already exists as a file or directory.
                   10365:         my ($state,$msg);
                   10366:         if ($context eq 'portfolio') {
                   10367:             my $port_path = $dirpath;
                   10368:             if ($group ne '') {
                   10369:                 $port_path = "groups/$group/$port_path";
                   10370:             }
1.987     raeburn  10371:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10372:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10373:                                               $dir_root,$port_path,$disk_quota,
                   10374:                                               $current_disk_usage,$uname,$udom);
                   10375:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10376:                 || $state eq 'file_locked') {
1.661     raeburn  10377:                 $output .= $msg;
                   10378:                 next;
                   10379:             }
                   10380:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10381:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10382:             if ($state eq 'exists') {
                   10383:                 $output .= $msg;
                   10384:                 next;
                   10385:             }
                   10386:         }
                   10387:         # Check if extension is valid
                   10388:         if (($fname =~ /\.(\w+)$/) &&
                   10389:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  10390:             $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  10391:             next;
                   10392:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10393:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10394:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10395:             next;
                   10396:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120    bisitz   10397:             $output .= &mt('Filename not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2).'<br />';
1.661     raeburn  10398:             next;
                   10399:         }
                   10400:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123    raeburn  10401:         my $subdir = $path;
                   10402:         $subdir =~ s{/+$}{};
1.661     raeburn  10403:         if ($context eq 'portfolio') {
1.984     raeburn  10404:             my $result;
                   10405:             if ($state eq 'existingfile') {
                   10406:                 $result=
                   10407:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123    raeburn  10408:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  10409:             } else {
1.984     raeburn  10410:                 $result=
                   10411:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10412:                                                     $dirpath.
1.1123    raeburn  10413:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  10414:                 if ($result !~ m|^/uploaded/|) {
                   10415:                     $output .= '<span class="LC_error">'
                   10416:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10417:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10418:                                .'</span><br />';
                   10419:                     next;
                   10420:                 } else {
1.987     raeburn  10421:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10422:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10423:                 }
1.661     raeburn  10424:             }
1.1123    raeburn  10425:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126    raeburn  10426:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   10427:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  10428:             my $result =
1.1126    raeburn  10429:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  10430:             if ($result !~ m|^/uploaded/|) {
                   10431:                 $output .= '<span class="LC_error">'
                   10432:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10433:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10434:                            .'</span><br />';
                   10435:                     next;
                   10436:             } else {
                   10437:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10438:                            $path.$fname.'</span>').'<br />';
1.1125    raeburn  10439:                 if ($context eq 'syllabus') {
                   10440:                     &Apache::lonnet::make_public_indefinitely($result);
                   10441:                 }
1.987     raeburn  10442:             }
1.661     raeburn  10443:         } else {
                   10444: # Save the file
                   10445:             my $target = $env{'form.embedded_item_'.$i};
                   10446:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10447:             my $dest = $fullpath.$fname;
                   10448:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10449:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10450:             my $count;
                   10451:             my $filepath = $dir_root;
1.1027    raeburn  10452:             foreach my $subdir (@parts) {
                   10453:                 $filepath .= "/$subdir";
                   10454:                 if (!-e $filepath) {
1.661     raeburn  10455:                     mkdir($filepath,0770);
                   10456:                 }
                   10457:             }
                   10458:             my $fh;
                   10459:             if (!open($fh,'>'.$dest)) {
                   10460:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10461:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10462:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10463:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10464:                            '</span><br />';
                   10465:             } else {
                   10466:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10467:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10468:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10469:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10470:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10471:                               '</span><br />';
                   10472:                 } else {
1.987     raeburn  10473:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10474:                                $url.'</span>').'<br />';
                   10475:                     unless ($context eq 'testbank') {
                   10476:                         $footer .= &mt('View embedded file: [_1]',
                   10477:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10478:                     }
                   10479:                 }
                   10480:                 close($fh);
                   10481:             }
                   10482:         }
                   10483:         if ($env{'form.embedded_ref_'.$i}) {
                   10484:             $pathchange{$i} = 1;
                   10485:         }
                   10486:     }
                   10487:     if ($output) {
                   10488:         $output = '<p>'.$output.'</p>';
                   10489:     }
                   10490:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10491:     $returnflag = 'ok';
1.1071    raeburn  10492:     my $numpathchgs = scalar(keys(%pathchange));
                   10493:     if ($numpathchgs > 0) {
1.987     raeburn  10494:         if ($context eq 'portfolio') {
                   10495:             $output .= '<p>'.&mt('or').'</p>';
                   10496:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10497:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10498:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10499:             $returnflag = 'modify_orightml';
                   10500:         }
                   10501:     }
1.1071    raeburn  10502:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10503: }
                   10504: 
                   10505: sub modify_html_form {
                   10506:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10507:     my $end = 0;
                   10508:     my $modifyform;
                   10509:     if ($context eq 'upload_embedded') {
                   10510:         return unless (ref($pathchange) eq 'HASH');
                   10511:         if ($env{'form.number_embedded_items'}) {
                   10512:             $end += $env{'form.number_embedded_items'};
                   10513:         }
                   10514:         if ($env{'form.number_pathchange_items'}) {
                   10515:             $end += $env{'form.number_pathchange_items'};
                   10516:         }
                   10517:         if ($end) {
                   10518:             for (my $i=0; $i<$end; $i++) {
                   10519:                 if ($i < $env{'form.number_embedded_items'}) {
                   10520:                     next unless($pathchange->{$i});
                   10521:                 }
                   10522:                 $modifyform .=
                   10523:                     &start_data_table_row().
                   10524:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10525:                     'checked="checked" /></td>'.
                   10526:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10527:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10528:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10529:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10530:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10531:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10532:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10533:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10534:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10535:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10536:                     &end_data_table_row();
1.1071    raeburn  10537:             }
1.987     raeburn  10538:         }
                   10539:     } else {
                   10540:         $modifyform = $pathchgtable;
                   10541:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10542:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10543:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10544:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10545:         }
                   10546:     }
                   10547:     if ($modifyform) {
1.1071    raeburn  10548:         if ($actionurl eq '/adm/dependencies') {
                   10549:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10550:         }
1.987     raeburn  10551:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10552:                '<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".
                   10553:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10554:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10555:                '</ol></p>'."\n".'<p>'.
                   10556:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10557:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10558:                &start_data_table()."\n".
                   10559:                &start_data_table_header_row().
                   10560:                '<th>'.&mt('Change?').'</th>'.
                   10561:                '<th>'.&mt('Current reference').'</th>'.
                   10562:                '<th>'.&mt('Required reference').'</th>'.
                   10563:                &end_data_table_header_row()."\n".
                   10564:                $modifyform.
                   10565:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10566:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10567:                '</form>'."\n";
                   10568:     }
                   10569:     return;
                   10570: }
                   10571: 
                   10572: sub modify_html_refs {
1.1123    raeburn  10573:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  10574:     my $container;
                   10575:     if ($context eq 'portfolio') {
                   10576:         $container = $env{'form.container'};
                   10577:     } elsif ($context eq 'coursedoc') {
                   10578:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10579:     } elsif ($context eq 'manage_dependencies') {
                   10580:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10581:         $container = "/$container";
1.1123    raeburn  10582:     } elsif ($context eq 'syllabus') {
                   10583:         $container = $url;
1.987     raeburn  10584:     } else {
1.1027    raeburn  10585:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10586:     }
                   10587:     my (%allfiles,%codebase,$output,$content);
                   10588:     my @changes = &get_env_multiple('form.namechange');
1.1126    raeburn  10589:     unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071    raeburn  10590:         if (wantarray) {
                   10591:             return ('',0,0); 
                   10592:         } else {
                   10593:             return;
                   10594:         }
                   10595:     }
                   10596:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  10597:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  10598:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10599:             if (wantarray) {
                   10600:                 return ('',0,0);
                   10601:             } else {
                   10602:                 return;
                   10603:             }
                   10604:         } 
1.987     raeburn  10605:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10606:         if ($content eq '-1') {
                   10607:             if (wantarray) {
                   10608:                 return ('',0,0);
                   10609:             } else {
                   10610:                 return;
                   10611:             }
                   10612:         }
1.987     raeburn  10613:     } else {
1.1071    raeburn  10614:         unless ($container =~ /^\Q$dir_root\E/) {
                   10615:             if (wantarray) {
                   10616:                 return ('',0,0);
                   10617:             } else {
                   10618:                 return;
                   10619:             }
                   10620:         } 
1.987     raeburn  10621:         if (open(my $fh,"<$container")) {
                   10622:             $content = join('', <$fh>);
                   10623:             close($fh);
                   10624:         } else {
1.1071    raeburn  10625:             if (wantarray) {
                   10626:                 return ('',0,0);
                   10627:             } else {
                   10628:                 return;
                   10629:             }
1.987     raeburn  10630:         }
                   10631:     }
                   10632:     my ($count,$codebasecount) = (0,0);
                   10633:     my $mm = new File::MMagic;
                   10634:     my $mime_type = $mm->checktype_contents($content);
                   10635:     if ($mime_type eq 'text/html') {
                   10636:         my $parse_result = 
                   10637:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10638:                                                     \%codebase,\$content);
                   10639:         if ($parse_result eq 'ok') {
                   10640:             foreach my $i (@changes) {
                   10641:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10642:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10643:                 if ($allfiles{$ref}) {
                   10644:                     my $newname =  $orig;
                   10645:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10646:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10647:                     if ($attrib_regexp =~ /:/) {
                   10648:                         $attrib_regexp =~ s/\:/|/g;
                   10649:                     }
                   10650:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10651:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10652:                         $count += $numchg;
1.1123    raeburn  10653:                         $allfiles{$newname} = $allfiles{$ref};
1.987     raeburn  10654:                     }
                   10655:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10656:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10657:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10658:                         $codebasecount ++;
                   10659:                     }
                   10660:                 }
                   10661:             }
1.1123    raeburn  10662:             my $skiprewrites;
1.987     raeburn  10663:             if ($count || $codebasecount) {
                   10664:                 my $saveresult;
1.1071    raeburn  10665:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  10666:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  10667:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10668:                     if ($url eq $container) {
                   10669:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10670:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10671:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10672:                                             $fname.'</span>').'</p>';
1.987     raeburn  10673:                     } else {
                   10674:                          $output = '<p class="LC_error">'.
                   10675:                                    &mt('Error: update failed for: [_1].',
                   10676:                                    '<span class="LC_filename">'.
                   10677:                                    $container.'</span>').'</p>';
                   10678:                     }
1.1123    raeburn  10679:                     if ($context eq 'syllabus') {
                   10680:                         unless ($saveresult eq 'ok') {
                   10681:                             $skiprewrites = 1;
                   10682:                         }
                   10683:                     }
1.987     raeburn  10684:                 } else {
                   10685:                     if (open(my $fh,">$container")) {
                   10686:                         print $fh $content;
                   10687:                         close($fh);
                   10688:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10689:                                   $count,'<span class="LC_filename">'.
                   10690:                                   $container.'</span>').'</p>';
1.661     raeburn  10691:                     } else {
1.987     raeburn  10692:                          $output = '<p class="LC_error">'.
                   10693:                                    &mt('Error: could not update [_1].',
                   10694:                                    '<span class="LC_filename">'.
                   10695:                                    $container.'</span>').'</p>';
1.661     raeburn  10696:                     }
                   10697:                 }
                   10698:             }
1.1123    raeburn  10699:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   10700:                 my ($actionurl,$state);
                   10701:                 $actionurl = "/public/$udom/$uname/syllabus";
                   10702:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   10703:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   10704:                                               \%codebase,
                   10705:                                               {'context' => 'rewrites',
                   10706:                                                'ignore_remote_references' => 1,});
                   10707:                 if (ref($mapping) eq 'HASH') {
                   10708:                     my $rewrites = 0;
                   10709:                     foreach my $key (keys(%{$mapping})) {
                   10710:                         next if ($key =~ m{^https?://});
                   10711:                         my $ref = $mapping->{$key};
                   10712:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   10713:                         my $attrib;
                   10714:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   10715:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   10716:                         }
                   10717:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10718:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10719:                             $rewrites += $numchg;
                   10720:                         }
                   10721:                     }
                   10722:                     if ($rewrites) {
                   10723:                         my $saveresult; 
                   10724:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10725:                         if ($url eq $container) {
                   10726:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   10727:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   10728:                                             $count,'<span class="LC_filename">'.
                   10729:                                             $fname.'</span>').'</p>';
                   10730:                         } else {
                   10731:                             $output .= '<p class="LC_error">'.
                   10732:                                        &mt('Error: could not update links in [_1].',
                   10733:                                        '<span class="LC_filename">'.
                   10734:                                        $container.'</span>').'</p>';
                   10735: 
                   10736:                         }
                   10737:                     }
                   10738:                 }
                   10739:             }
1.987     raeburn  10740:         } else {
                   10741:             &logthis('Failed to parse '.$container.
                   10742:                      ' to modify references: '.$parse_result);
1.661     raeburn  10743:         }
                   10744:     }
1.1071    raeburn  10745:     if (wantarray) {
                   10746:         return ($output,$count,$codebasecount);
                   10747:     } else {
                   10748:         return $output;
                   10749:     }
1.661     raeburn  10750: }
                   10751: 
                   10752: sub check_for_existing {
                   10753:     my ($path,$fname,$element) = @_;
                   10754:     my ($state,$msg);
                   10755:     if (-d $path.'/'.$fname) {
                   10756:         $state = 'exists';
                   10757:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10758:     } elsif (-e $path.'/'.$fname) {
                   10759:         $state = 'exists';
                   10760:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10761:     }
                   10762:     if ($state eq 'exists') {
                   10763:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10764:     }
                   10765:     return ($state,$msg);
                   10766: }
                   10767: 
                   10768: sub check_for_upload {
                   10769:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10770:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10771:     my $filesize = length($env{'form.'.$element});
                   10772:     if (!$filesize) {
                   10773:         my $msg = '<span class="LC_error">'.
                   10774:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10775:                       '<span class="LC_filename">'.$fname.'</span>',
                   10776:                       $filesize).'<br />'.
1.1007    raeburn  10777:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10778:                   '</span>';
                   10779:         return ('zero_bytes',$msg);
                   10780:     }
                   10781:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10782:     my $getpropath = 1;
1.1021    raeburn  10783:     my ($dirlistref,$listerror) =
                   10784:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10785:     my $found_file = 0;
                   10786:     my $locked_file = 0;
1.991     raeburn  10787:     my @lockers;
                   10788:     my $navmap;
                   10789:     if ($env{'request.course.id'}) {
                   10790:         $navmap = Apache::lonnavmaps::navmap->new();
                   10791:     }
1.1021    raeburn  10792:     if (ref($dirlistref) eq 'ARRAY') {
                   10793:         foreach my $line (@{$dirlistref}) {
                   10794:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10795:             if ($file_name eq $fname){
                   10796:                 $file_name = $path.$file_name;
                   10797:                 if ($group ne '') {
                   10798:                     $file_name = $group.$file_name;
                   10799:                 }
                   10800:                 $found_file = 1;
                   10801:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10802:                     foreach my $lock (@lockers) {
                   10803:                         if (ref($lock) eq 'ARRAY') {
                   10804:                             my ($symb,$crsid) = @{$lock};
                   10805:                             if ($crsid eq $env{'request.course.id'}) {
                   10806:                                 if (ref($navmap)) {
                   10807:                                     my $res = $navmap->getBySymb($symb);
                   10808:                                     foreach my $part (@{$res->parts()}) { 
                   10809:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10810:                                         unless (($slot_status == $res->RESERVED) ||
                   10811:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10812:                                             $locked_file = 1;
                   10813:                                         }
1.991     raeburn  10814:                                     }
1.1021    raeburn  10815:                                 } else {
                   10816:                                     $locked_file = 1;
1.991     raeburn  10817:                                 }
                   10818:                             } else {
                   10819:                                 $locked_file = 1;
                   10820:                             }
                   10821:                         }
1.1021    raeburn  10822:                    }
                   10823:                 } else {
                   10824:                     my @info = split(/\&/,$rest);
                   10825:                     my $currsize = $info[6]/1000;
                   10826:                     if ($currsize < $filesize) {
                   10827:                         my $extra = $filesize - $currsize;
                   10828:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   10829:                             my $msg = '<span class="LC_error">'.
                   10830:                                       &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.',
                   10831:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   10832:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10833:                                                    $disk_quota,$current_disk_usage);
                   10834:                             return ('will_exceed_quota',$msg);
                   10835:                         }
1.984     raeburn  10836:                     }
                   10837:                 }
1.661     raeburn  10838:             }
                   10839:         }
                   10840:     }
                   10841:     if (($current_disk_usage + $filesize) > $disk_quota){
                   10842:         my $msg = '<span class="LC_error">'.
                   10843:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   10844:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   10845:         return ('will_exceed_quota',$msg);
                   10846:     } elsif ($found_file) {
                   10847:         if ($locked_file) {
                   10848:             my $msg = '<span class="LC_error">';
                   10849:             $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>');
                   10850:             $msg .= '</span><br />';
                   10851:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10852:             return ('file_locked',$msg);
                   10853:         } else {
                   10854:             my $msg = '<span class="LC_error">';
1.984     raeburn  10855:             $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  10856:             $msg .= '</span>';
1.984     raeburn  10857:             return ('existingfile',$msg);
1.661     raeburn  10858:         }
                   10859:     }
                   10860: }
                   10861: 
1.987     raeburn  10862: sub check_for_traversal {
                   10863:     my ($path,$url,$toplevel) = @_;
                   10864:     my @parts=split(/\//,$path);
                   10865:     my $cleanpath;
                   10866:     my $fullpath = $url;
                   10867:     for (my $i=0;$i<@parts;$i++) {
                   10868:         next if ($parts[$i] eq '.');
                   10869:         if ($parts[$i] eq '..') {
                   10870:             $fullpath =~ s{([^/]+/)$}{};
                   10871:         } else {
                   10872:             $fullpath .= $parts[$i].'/';
                   10873:         }
                   10874:     }
                   10875:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10876:         $cleanpath = $1;
                   10877:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10878:         my $curr_toprel = $1;
                   10879:         my @parts = split(/\//,$curr_toprel);
                   10880:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10881:         my @urlparts = split(/\//,$url_toprel);
                   10882:         my $doubledots;
                   10883:         my $startdiff = -1;
                   10884:         for (my $i=0; $i<@urlparts; $i++) {
                   10885:             if ($startdiff == -1) {
                   10886:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10887:                     $startdiff = $i;
                   10888:                     $doubledots .= '../';
                   10889:                 }
                   10890:             } else {
                   10891:                 $doubledots .= '../';
                   10892:             }
                   10893:         }
                   10894:         if ($startdiff > -1) {
                   10895:             $cleanpath = $doubledots;
                   10896:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10897:                 $cleanpath .= $parts[$i].'/';
                   10898:             }
                   10899:         }
                   10900:     }
                   10901:     $cleanpath =~ s{(/)$}{};
                   10902:     return $cleanpath;
                   10903: }
1.31      albertel 10904: 
1.1053    raeburn  10905: sub is_archive_file {
                   10906:     my ($mimetype) = @_;
                   10907:     if (($mimetype eq 'application/octet-stream') ||
                   10908:         ($mimetype eq 'application/x-stuffit') ||
                   10909:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   10910:         return 1;
                   10911:     }
                   10912:     return;
                   10913: }
                   10914: 
                   10915: sub decompress_form {
1.1065    raeburn  10916:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  10917:     my %lt = &Apache::lonlocal::texthash (
                   10918:         this => 'This file is an archive file.',
1.1067    raeburn  10919:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  10920:         itsc => 'Its contents are as follows:',
1.1053    raeburn  10921:         youm => 'You may wish to extract its contents.',
                   10922:         extr => 'Extract contents',
1.1067    raeburn  10923:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   10924:         proa => 'Process automatically?',
1.1053    raeburn  10925:         yes  => 'Yes',
                   10926:         no   => 'No',
1.1067    raeburn  10927:         fold => 'Title for folder containing movie',
                   10928:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  10929:     );
1.1065    raeburn  10930:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  10931:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  10932:     my $info = &list_archive_contents($fileloc,\@paths);
                   10933:     if (@paths) {
                   10934:         foreach my $path (@paths) {
                   10935:             $path =~ s{^/}{};
1.1067    raeburn  10936:             if ($path =~ m{^([^/]+)/$}) {
                   10937:                 $topdir = $1;
                   10938:             }
1.1065    raeburn  10939:             if ($path =~ m{^([^/]+)/}) {
                   10940:                 $toplevel{$1} = $path;
                   10941:             } else {
                   10942:                 $toplevel{$path} = $path;
                   10943:             }
                   10944:         }
                   10945:     }
1.1067    raeburn  10946:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
                   10947:         my @camtasia = ("$topdir/","$topdir/index.html",
                   10948:                         "$topdir/media/",
                   10949:                         "$topdir/media/$topdir.mp4",
                   10950:                         "$topdir/media/FirstFrame.png",
                   10951:                         "$topdir/media/player.swf",
                   10952:                         "$topdir/media/swfobject.js",
                   10953:                         "$topdir/media/expressInstall.swf");
                   10954:         my @diffs = &compare_arrays(\@paths,\@camtasia);
                   10955:         if (@diffs == 0) {
                   10956:             $is_camtasia = 1;
                   10957:         }
                   10958:     }
                   10959:     my $output;
                   10960:     if ($is_camtasia) {
                   10961:         $output = <<"ENDCAM";
                   10962: <script type="text/javascript" language="Javascript">
                   10963: // <![CDATA[
                   10964: 
                   10965: function camtasiaToggle() {
                   10966:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   10967:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
                   10968:             if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
                   10969: 
                   10970:                 document.getElementById('camtasia_titles').style.display='block';
                   10971:             } else {
                   10972:                 document.getElementById('camtasia_titles').style.display='none';
                   10973:             }
                   10974:         }
                   10975:     }
                   10976:     return;
                   10977: }
                   10978: 
                   10979: // ]]>
                   10980: </script>
                   10981: <p>$lt{'camt'}</p>
                   10982: ENDCAM
1.1065    raeburn  10983:     } else {
1.1067    raeburn  10984:         $output = '<p>'.$lt{'this'};
                   10985:         if ($info eq '') {
                   10986:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   10987:         } else {
                   10988:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   10989:                        '<div><pre>'.$info.'</pre></div>';
                   10990:         }
1.1065    raeburn  10991:     }
1.1067    raeburn  10992:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  10993:     my $duplicates;
                   10994:     my $num = 0;
                   10995:     if (ref($dirlist) eq 'ARRAY') {
                   10996:         foreach my $item (@{$dirlist}) {
                   10997:             if (ref($item) eq 'ARRAY') {
                   10998:                 if (exists($toplevel{$item->[0]})) {
                   10999:                     $duplicates .= 
                   11000:                         &start_data_table_row().
                   11001:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11002:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11003:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11004:                         'value="1" />'.&mt('Yes').'</label>'.
                   11005:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11006:                         '<td>'.$item->[0].'</td>';
                   11007:                     if ($item->[2]) {
                   11008:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11009:                     } else {
                   11010:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11011:                     }
                   11012:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11013:                                    '<td>'.
                   11014:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11015:                                    '</td>'.
                   11016:                                    &end_data_table_row();
                   11017:                     $num ++;
                   11018:                 }
                   11019:             }
                   11020:         }
                   11021:     }
                   11022:     my $itemcount;
                   11023:     if (@paths > 0) {
                   11024:         $itemcount = scalar(@paths);
                   11025:     } else {
                   11026:         $itemcount = 1;
                   11027:     }
1.1067    raeburn  11028:     if ($is_camtasia) {
                   11029:         $output .= $lt{'auto'}.'<br />'.
                   11030:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                   11031:                    '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                   11032:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11033:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11034:                    $lt{'no'}.'</label></span><br />'.
                   11035:                    '<div id="camtasia_titles" style="display:block">'.
                   11036:                    &Apache::lonhtmlcommon::start_pick_box().
                   11037:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11038:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11039:                    &Apache::lonhtmlcommon::row_closure().
                   11040:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11041:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11042:                    &Apache::lonhtmlcommon::row_closure(1).
                   11043:                    &Apache::lonhtmlcommon::end_pick_box().
                   11044:                    '</div>';
                   11045:     }
1.1065    raeburn  11046:     $output .= 
                   11047:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11048:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11049:         "\n";
1.1065    raeburn  11050:     if ($duplicates ne '') {
                   11051:         $output .= '<p><span class="LC_warning">'.
                   11052:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11053:                    &start_data_table().
                   11054:                    &start_data_table_header_row().
                   11055:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11056:                    '<th>'.&mt('Name').'</th>'.
                   11057:                    '<th>'.&mt('Type').'</th>'.
                   11058:                    '<th>'.&mt('Size').'</th>'.
                   11059:                    '<th>'.&mt('Last modified').'</th>'.
                   11060:                    &end_data_table_header_row().
                   11061:                    $duplicates.
                   11062:                    &end_data_table().
                   11063:                    '</p>';
                   11064:     }
1.1067    raeburn  11065:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11066:     if (ref($hiddenelements) eq 'HASH') {
                   11067:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11068:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11069:         }
                   11070:     }
                   11071:     $output .= <<"END";
1.1067    raeburn  11072: <br />
1.1053    raeburn  11073: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11074: </form>
                   11075: $noextract
                   11076: END
                   11077:     return $output;
                   11078: }
                   11079: 
1.1065    raeburn  11080: sub decompression_utility {
                   11081:     my ($program) = @_;
                   11082:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11083:     my $location;
                   11084:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11085:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11086:                          '/usr/sbin/') {
                   11087:             if (-x $dir.$program) {
                   11088:                 $location = $dir.$program;
                   11089:                 last;
                   11090:             }
                   11091:         }
                   11092:     }
                   11093:     return $location;
                   11094: }
                   11095: 
                   11096: sub list_archive_contents {
                   11097:     my ($file,$pathsref) = @_;
                   11098:     my (@cmd,$output);
                   11099:     my $needsregexp;
                   11100:     if ($file =~ /\.zip$/) {
                   11101:         @cmd = (&decompression_utility('unzip'),"-l");
                   11102:         $needsregexp = 1;
                   11103:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11104:              ($file =~ /\.tgz$/)) {
                   11105:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11106:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11107:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11108:     } elsif ($file =~ m|\.tar$|) {
                   11109:         @cmd = (&decompression_utility('tar'),"-tf");
                   11110:     }
                   11111:     if (@cmd) {
                   11112:         undef($!);
                   11113:         undef($@);
                   11114:         if (open(my $fh,"-|", @cmd, $file)) {
                   11115:             while (my $line = <$fh>) {
                   11116:                 $output .= $line;
                   11117:                 chomp($line);
                   11118:                 my $item;
                   11119:                 if ($needsregexp) {
                   11120:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11121:                 } else {
                   11122:                     $item = $line;
                   11123:                 }
                   11124:                 if ($item ne '') {
                   11125:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11126:                         push(@{$pathsref},$item);
                   11127:                     } 
                   11128:                 }
                   11129:             }
                   11130:             close($fh);
                   11131:         }
                   11132:     }
                   11133:     return $output;
                   11134: }
                   11135: 
1.1053    raeburn  11136: sub decompress_uploaded_file {
                   11137:     my ($file,$dir) = @_;
                   11138:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11139:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11140:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11141:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11142:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11143:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11144:     my $decompressed = $env{'cgi.decompressed'};
                   11145:     &Apache::lonnet::delenv('cgi.file');
                   11146:     &Apache::lonnet::delenv('cgi.dir');
                   11147:     &Apache::lonnet::delenv('cgi.decompressed');
                   11148:     return ($decompressed,$result);
                   11149: }
                   11150: 
1.1055    raeburn  11151: sub process_decompression {
                   11152:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11153:     my ($dir,$error,$warning,$output);
                   11154:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
1.1120    bisitz   11155:         $error = &mt('Filename not a supported archive file type.').
                   11156:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11157:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11158:     } else {
                   11159:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11160:         if ($docuhome eq 'no_host') {
                   11161:             $error = &mt('Could not determine home server for course.');
                   11162:         } else {
                   11163:             my @ids=&Apache::lonnet::current_machine_ids();
                   11164:             my $currdir = "$dir_root/$destination";
                   11165:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11166:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11167:                        "$dir_root/$destination";
                   11168:             } else {
                   11169:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11170:                        "$dir_root/$docudom/$docuname/$destination";
                   11171:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11172:                     $error = &mt('Archive file not found.');
                   11173:                 }
                   11174:             }
1.1065    raeburn  11175:             my (@to_overwrite,@to_skip);
                   11176:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11177:                 my $total = $env{'form.archive_overwrite_total'};
                   11178:                 for (my $i=0; $i<$total; $i++) {
                   11179:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11180:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11181:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11182:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11183:                     }
                   11184:                 }
                   11185:             }
                   11186:             my $numskip = scalar(@to_skip);
                   11187:             if (($numskip > 0) && 
                   11188:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11189:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11190:             } elsif ($dir eq '') {
1.1055    raeburn  11191:                 $error = &mt('Directory containing archive file unavailable.');
                   11192:             } elsif (!$error) {
1.1065    raeburn  11193:                 my ($decompressed,$display);
                   11194:                 if ($numskip > 0) {
                   11195:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11196:                     mkdir("$dir/$tempdir",0755);
                   11197:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11198:                     ($decompressed,$display) = 
                   11199:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11200:                     foreach my $item (@to_skip) {
                   11201:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11202:                             if (-f "$dir/$tempdir/$item") { 
                   11203:                                 unlink("$dir/$tempdir/$item");
                   11204:                             } elsif (-d "$dir/$tempdir/$item") {
                   11205:                                 system("rm -rf $dir/$tempdir/$item");
                   11206:                             }
                   11207:                         }
                   11208:                     }
                   11209:                     system("mv $dir/$tempdir/* $dir");
                   11210:                     rmdir("$dir/$tempdir");   
                   11211:                 } else {
                   11212:                     ($decompressed,$display) = 
                   11213:                         &decompress_uploaded_file($file,$dir);
                   11214:                 }
1.1055    raeburn  11215:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11216:                     $output = '<p class="LC_info">'.
                   11217:                               &mt('Files extracted successfully from archive.').
                   11218:                               '</p>'."\n";
1.1055    raeburn  11219:                     my ($warning,$result,@contents);
                   11220:                     my ($newdirlistref,$newlisterror) =
                   11221:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11222:                                                  $docuname,1);
                   11223:                     my (%is_dir,%changes,@newitems);
                   11224:                     my $dirptr = 16384;
1.1065    raeburn  11225:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11226:                         foreach my $dir_line (@{$newdirlistref}) {
                   11227:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11228:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11229:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11230:                                 push(@newitems,$item);
                   11231:                                 if ($dirptr&$testdir) {
                   11232:                                     $is_dir{$item} = 1;
                   11233:                                 }
                   11234:                                 $changes{$item} = 1;
                   11235:                             }
                   11236:                         }
                   11237:                     }
                   11238:                     if (keys(%changes) > 0) {
                   11239:                         foreach my $item (sort(@newitems)) {
                   11240:                             if ($changes{$item}) {
                   11241:                                 push(@contents,$item);
                   11242:                             }
                   11243:                         }
                   11244:                     }
                   11245:                     if (@contents > 0) {
1.1067    raeburn  11246:                         my $wantform;
                   11247:                         unless ($env{'form.autoextract_camtasia'}) {
                   11248:                             $wantform = 1;
                   11249:                         }
1.1056    raeburn  11250:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11251:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11252:                                                                 $currdir,\%is_dir,
                   11253:                                                                 \%children,\%parent,
1.1056    raeburn  11254:                                                                 \@contents,\%dirorder,
                   11255:                                                                 \%titles,$wantform);
1.1055    raeburn  11256:                         if ($datatable ne '') {
                   11257:                             $output .= &archive_options_form('decompressed',$datatable,
                   11258:                                                              $count,$hiddenelem);
1.1065    raeburn  11259:                             my $startcount = 6;
1.1055    raeburn  11260:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11261:                                                            \%titles,\%children);
1.1055    raeburn  11262:                         }
1.1067    raeburn  11263:                         if ($env{'form.autoextract_camtasia'}) {
                   11264:                             my %displayed;
                   11265:                             my $total = 1;
                   11266:                             $env{'form.archive_directory'} = [];
                   11267:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11268:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11269:                                 $path =~ s{/$}{};
                   11270:                                 my $item;
                   11271:                                 if ($path ne '') {
                   11272:                                     $item = "$path/$titles{$i}";
                   11273:                                 } else {
                   11274:                                     $item = $titles{$i};
                   11275:                                 }
                   11276:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11277:                                 if ($item eq $contents[0]) {
                   11278:                                     push(@{$env{'form.archive_directory'}},$i);
                   11279:                                     $env{'form.archive_'.$i} = 'display';
                   11280:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11281:                                     $displayed{'folder'} = $i;
                   11282:                                 } elsif ($item eq "$contents[0]/index.html") {
                   11283:                                     $env{'form.archive_'.$i} = 'display';
                   11284:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11285:                                     $displayed{'web'} = $i;
                   11286:                                 } else {
                   11287:                                     if ($item eq "$contents[0]/media") {
                   11288:                                         push(@{$env{'form.archive_directory'}},$i);
                   11289:                                     }
                   11290:                                     $env{'form.archive_'.$i} = 'dependency';
                   11291:                                 }
                   11292:                                 $total ++;
                   11293:                             }
                   11294:                             for (my $i=1; $i<$total; $i++) {
                   11295:                                 next if ($i == $displayed{'web'});
                   11296:                                 next if ($i == $displayed{'folder'});
                   11297:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11298:                             }
                   11299:                             $env{'form.phase'} = 'decompress_cleanup';
                   11300:                             $env{'form.archivedelete'} = 1;
                   11301:                             $env{'form.archive_count'} = $total-1;
                   11302:                             $output .=
                   11303:                                 &process_extracted_files('coursedocs',$docudom,
                   11304:                                                          $docuname,$destination,
                   11305:                                                          $dir_root,$hiddenelem);
                   11306:                         }
1.1055    raeburn  11307:                     } else {
                   11308:                         $warning = &mt('No new items extracted from archive file.');
                   11309:                     }
                   11310:                 } else {
                   11311:                     $output = $display;
                   11312:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11313:                 }
                   11314:             }
                   11315:         }
                   11316:     }
                   11317:     if ($error) {
                   11318:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11319:                    $error.'</p>'."\n";
                   11320:     }
                   11321:     if ($warning) {
                   11322:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11323:     }
                   11324:     return $output;
                   11325: }
                   11326: 
                   11327: sub get_extracted {
1.1056    raeburn  11328:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11329:         $titles,$wantform) = @_;
1.1055    raeburn  11330:     my $count = 0;
                   11331:     my $depth = 0;
                   11332:     my $datatable;
1.1056    raeburn  11333:     my @hierarchy;
1.1055    raeburn  11334:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11335:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11336:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11337:     foreach my $item (@{$contents}) {
                   11338:         $count ++;
1.1056    raeburn  11339:         @{$dirorder->{$count}} = @hierarchy;
                   11340:         $titles->{$count} = $item;
1.1055    raeburn  11341:         &archive_hierarchy($depth,$count,$parent,$children);
                   11342:         if ($wantform) {
                   11343:             $datatable .= &archive_row($is_dir->{$item},$item,
                   11344:                                        $currdir,$depth,$count);
                   11345:         }
                   11346:         if ($is_dir->{$item}) {
                   11347:             $depth ++;
1.1056    raeburn  11348:             push(@hierarchy,$count);
                   11349:             $parent->{$depth} = $count;
1.1055    raeburn  11350:             $datatable .=
                   11351:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  11352:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   11353:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  11354:             $depth --;
1.1056    raeburn  11355:             pop(@hierarchy);
1.1055    raeburn  11356:         }
                   11357:     }
                   11358:     return ($count,$datatable);
                   11359: }
                   11360: 
                   11361: sub recurse_extracted_archive {
1.1056    raeburn  11362:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   11363:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  11364:     my $result='';
1.1056    raeburn  11365:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   11366:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   11367:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  11368:         return $result;
                   11369:     }
                   11370:     my $dirptr = 16384;
                   11371:     my ($newdirlistref,$newlisterror) =
                   11372:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   11373:     if (ref($newdirlistref) eq 'ARRAY') {
                   11374:         foreach my $dir_line (@{$newdirlistref}) {
                   11375:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   11376:             unless ($item =~ /^\.+$/) {
                   11377:                 $$count ++;
1.1056    raeburn  11378:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   11379:                 $titles->{$$count} = $item;
1.1055    raeburn  11380:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  11381: 
1.1055    raeburn  11382:                 my $is_dir;
                   11383:                 if ($dirptr&$testdir) {
                   11384:                     $is_dir = 1;
                   11385:                 }
                   11386:                 if ($wantform) {
                   11387:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11388:                 }
                   11389:                 if ($is_dir) {
                   11390:                     $$depth ++;
1.1056    raeburn  11391:                     push(@{$hierarchy},$$count);
                   11392:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11393:                     $result .=
                   11394:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11395:                                                    $docuname,$depth,$count,
1.1056    raeburn  11396:                                                    $hierarchy,$dirorder,$children,
                   11397:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11398:                     $$depth --;
1.1056    raeburn  11399:                     pop(@{$hierarchy});
1.1055    raeburn  11400:                 }
                   11401:             }
                   11402:         }
                   11403:     }
                   11404:     return $result;
                   11405: }
                   11406: 
                   11407: sub archive_hierarchy {
                   11408:     my ($depth,$count,$parent,$children) =@_;
                   11409:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11410:         if (exists($parent->{$depth})) {
                   11411:              $children->{$parent->{$depth}} .= $count.':';
                   11412:         }
                   11413:     }
                   11414:     return;
                   11415: }
                   11416: 
                   11417: sub archive_row {
                   11418:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11419:     my ($name) = ($item =~ m{([^/]+)$});
                   11420:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11421:                                        'display'    => 'Add as file',
1.1055    raeburn  11422:                                        'dependency' => 'Include as dependency',
                   11423:                                        'discard'    => 'Discard',
                   11424:                                       );
                   11425:     if ($is_dir) {
1.1059    raeburn  11426:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11427:     }
1.1056    raeburn  11428:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11429:     my $offset = 0;
1.1055    raeburn  11430:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11431:         $offset ++;
1.1065    raeburn  11432:         if ($action ne 'display') {
                   11433:             $offset ++;
                   11434:         }  
1.1055    raeburn  11435:         $output .= '<td><span class="LC_nobreak">'.
                   11436:                    '<label><input type="radio" name="archive_'.$count.
                   11437:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11438:         my $text = $choices{$action};
                   11439:         if ($is_dir) {
                   11440:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11441:             if ($action eq 'display') {
1.1059    raeburn  11442:                 $text = &mt('Add as folder');
1.1055    raeburn  11443:             }
1.1056    raeburn  11444:         } else {
                   11445:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11446: 
                   11447:         }
                   11448:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11449:         if ($action eq 'dependency') {
                   11450:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11451:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11452:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11453:                        '<option value=""></option>'."\n".
                   11454:                        '</select>'."\n".
                   11455:                        '</div>';
1.1059    raeburn  11456:         } elsif ($action eq 'display') {
                   11457:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11458:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11459:                        '</div>';
1.1055    raeburn  11460:         }
1.1056    raeburn  11461:         $output .= '</td>';
1.1055    raeburn  11462:     }
                   11463:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11464:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11465:     for (my $i=0; $i<$depth; $i++) {
                   11466:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11467:     }
                   11468:     if ($is_dir) {
                   11469:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11470:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11471:     } else {
                   11472:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11473:     }
                   11474:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11475:                &end_data_table_row();
                   11476:     return $output;
                   11477: }
                   11478: 
                   11479: sub archive_options_form {
1.1065    raeburn  11480:     my ($form,$display,$count,$hiddenelem) = @_;
                   11481:     my %lt = &Apache::lonlocal::texthash(
                   11482:                perm => 'Permanently remove archive file?',
                   11483:                hows => 'How should each extracted item be incorporated in the course?',
                   11484:                cont => 'Content actions for all',
                   11485:                addf => 'Add as folder/file',
                   11486:                incd => 'Include as dependency for a displayed file',
                   11487:                disc => 'Discard',
                   11488:                no   => 'No',
                   11489:                yes  => 'Yes',
                   11490:                save => 'Save',
                   11491:     );
                   11492:     my $output = <<"END";
                   11493: <form name="$form" method="post" action="">
                   11494: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11495: <label>
                   11496:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11497: </label>
                   11498: &nbsp;
                   11499: <label>
                   11500:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11501: </span>
                   11502: </p>
                   11503: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11504: <br />$lt{'hows'}
                   11505: <div class="LC_columnSection">
                   11506:   <fieldset>
                   11507:     <legend>$lt{'cont'}</legend>
                   11508:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11509:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11510:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11511:   </fieldset>
                   11512: </div>
                   11513: END
                   11514:     return $output.
1.1055    raeburn  11515:            &start_data_table()."\n".
1.1065    raeburn  11516:            $display."\n".
1.1055    raeburn  11517:            &end_data_table()."\n".
                   11518:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11519:            $hiddenelem.
1.1065    raeburn  11520:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11521:            '</form>';
                   11522: }
                   11523: 
                   11524: sub archive_javascript {
1.1056    raeburn  11525:     my ($startcount,$numitems,$titles,$children) = @_;
                   11526:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11527:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11528:     my $scripttag = <<START;
                   11529: <script type="text/javascript">
                   11530: // <![CDATA[
                   11531: 
                   11532: function checkAll(form,prefix) {
                   11533:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11534:     for (var i=0; i < form.elements.length; i++) {
                   11535:         var id = form.elements[i].id;
                   11536:         if ((id != '') && (id != undefined)) {
                   11537:             if (idstr.test(id)) {
                   11538:                 if (form.elements[i].type == 'radio') {
                   11539:                     form.elements[i].checked = true;
1.1056    raeburn  11540:                     var nostart = i-$startcount;
1.1059    raeburn  11541:                     var offset = nostart%7;
                   11542:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11543:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11544:                 }
                   11545:             }
                   11546:         }
                   11547:     }
                   11548: }
                   11549: 
                   11550: function propagateCheck(form,count) {
                   11551:     if (count > 0) {
1.1059    raeburn  11552:         var startelement = $startcount + ((count-1) * 7);
                   11553:         for (var j=1; j<6; j++) {
                   11554:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11555:                 var item = startelement + j; 
                   11556:                 if (form.elements[item].type == 'radio') {
                   11557:                     if (form.elements[item].checked) {
                   11558:                         containerCheck(form,count,j);
                   11559:                         break;
                   11560:                     }
1.1055    raeburn  11561:                 }
                   11562:             }
                   11563:         }
                   11564:     }
                   11565: }
                   11566: 
                   11567: numitems = $numitems
1.1056    raeburn  11568: var titles = new Array(numitems);
                   11569: var parents = new Array(numitems);
1.1055    raeburn  11570: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11571:     parents[i] = new Array;
1.1055    raeburn  11572: }
1.1059    raeburn  11573: var maintitle = '$maintitle';
1.1055    raeburn  11574: 
                   11575: START
                   11576: 
1.1056    raeburn  11577:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11578:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11579:         for (my $i=0; $i<@contents; $i ++) {
                   11580:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11581:         }
                   11582:     }
                   11583: 
1.1056    raeburn  11584:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11585:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11586:     }
                   11587: 
1.1055    raeburn  11588:     $scripttag .= <<END;
                   11589: 
                   11590: function containerCheck(form,count,offset) {
                   11591:     if (count > 0) {
1.1056    raeburn  11592:         dependencyCheck(form,count,offset);
1.1059    raeburn  11593:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11594:         form.elements[item].checked = true;
                   11595:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11596:             if (parents[count].length > 0) {
                   11597:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11598:                     containerCheck(form,parents[count][j],offset);
                   11599:                 }
                   11600:             }
                   11601:         }
                   11602:     }
                   11603: }
                   11604: 
                   11605: function dependencyCheck(form,count,offset) {
                   11606:     if (count > 0) {
1.1059    raeburn  11607:         var chosen = (offset+$startcount)+7*(count-1);
                   11608:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11609:         var currtype = form.elements[depitem].type;
                   11610:         if (form.elements[chosen].value == 'dependency') {
                   11611:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11612:             form.elements[depitem].options.length = 0;
                   11613:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  11614:             for (var i=1; i<=numitems; i++) {
                   11615:                 if (i == count) {
                   11616:                     continue;
                   11617:                 }
1.1059    raeburn  11618:                 var startelement = $startcount + (i-1) * 7;
                   11619:                 for (var j=1; j<6; j++) {
                   11620:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11621:                         var item = startelement + j;
                   11622:                         if (form.elements[item].type == 'radio') {
                   11623:                             if (form.elements[item].checked) {
                   11624:                                 if (form.elements[item].value == 'display') {
                   11625:                                     var n = form.elements[depitem].options.length;
                   11626:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11627:                                 }
                   11628:                             }
                   11629:                         }
                   11630:                     }
                   11631:                 }
                   11632:             }
                   11633:         } else {
                   11634:             document.getElementById('arc_depon_'+count).style.display='none';
                   11635:             form.elements[depitem].options.length = 0;
                   11636:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11637:         }
1.1059    raeburn  11638:         titleCheck(form,count,offset);
1.1056    raeburn  11639:     }
                   11640: }
                   11641: 
                   11642: function propagateSelect(form,count,offset) {
                   11643:     if (count > 0) {
1.1065    raeburn  11644:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11645:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11646:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11647:             if (parents[count].length > 0) {
                   11648:                 for (var j=0; j<parents[count].length; j++) {
                   11649:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11650:                 }
                   11651:             }
                   11652:         }
                   11653:     }
                   11654: }
1.1056    raeburn  11655: 
                   11656: function containerSelect(form,count,offset,picked) {
                   11657:     if (count > 0) {
1.1065    raeburn  11658:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11659:         if (form.elements[item].type == 'radio') {
                   11660:             if (form.elements[item].value == 'dependency') {
                   11661:                 if (form.elements[item+1].type == 'select-one') {
                   11662:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11663:                         if (form.elements[item+1].options[i].value == picked) {
                   11664:                             form.elements[item+1].selectedIndex = i;
                   11665:                             break;
                   11666:                         }
                   11667:                     }
                   11668:                 }
                   11669:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11670:                     if (parents[count].length > 0) {
                   11671:                         for (var j=0; j<parents[count].length; j++) {
                   11672:                             containerSelect(form,parents[count][j],offset,picked);
                   11673:                         }
                   11674:                     }
                   11675:                 }
                   11676:             }
                   11677:         }
                   11678:     }
                   11679: }
                   11680: 
1.1059    raeburn  11681: function titleCheck(form,count,offset) {
                   11682:     if (count > 0) {
                   11683:         var chosen = (offset+$startcount)+7*(count-1);
                   11684:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11685:         var currtype = form.elements[depitem].type;
                   11686:         if (form.elements[chosen].value == 'display') {
                   11687:             document.getElementById('arc_title_'+count).style.display='block';
                   11688:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11689:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11690:             }
                   11691:         } else {
                   11692:             document.getElementById('arc_title_'+count).style.display='none';
                   11693:             if (currtype == 'text') { 
                   11694:                 document.getElementById('archive_title_'+count).value='';
                   11695:             }
                   11696:         }
                   11697:     }
                   11698:     return;
                   11699: }
                   11700: 
1.1055    raeburn  11701: // ]]>
                   11702: </script>
                   11703: END
                   11704:     return $scripttag;
                   11705: }
                   11706: 
                   11707: sub process_extracted_files {
1.1067    raeburn  11708:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11709:     my $numitems = $env{'form.archive_count'};
                   11710:     return unless ($numitems);
                   11711:     my @ids=&Apache::lonnet::current_machine_ids();
                   11712:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11713:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11714:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11715:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11716:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11717:         $pathtocheck = "$dir_root/$destination";
                   11718:         $dir = $dir_root;
                   11719:         $ishome = 1;
                   11720:     } else {
                   11721:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11722:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11723:         $dir = "$dir_root/$docudom/$docuname";    
                   11724:     }
                   11725:     my $currdir = "$dir_root/$destination";
                   11726:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11727:     if ($env{'form.folderpath'}) {
                   11728:         my @items = split('&',$env{'form.folderpath'});
                   11729:         $folders{'0'} = $items[-2];
1.1099    raeburn  11730:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11731:             $containers{'0'}='page';
                   11732:         } else {  
                   11733:             $containers{'0'}='sequence';
                   11734:         }
1.1055    raeburn  11735:     }
                   11736:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11737:     if ($numitems) {
                   11738:         for (my $i=1; $i<=$numitems; $i++) {
                   11739:             my $path = $env{'form.archive_content_'.$i};
                   11740:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11741:                 my $item = $1;
                   11742:                 $toplevelitems{$item} = $i;
                   11743:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11744:                     $is_dir{$item} = 1;
                   11745:                 }
                   11746:             }
                   11747:         }
                   11748:     }
1.1067    raeburn  11749:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11750:     if (keys(%toplevelitems) > 0) {
                   11751:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11752:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11753:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11754:     }
1.1066    raeburn  11755:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11756:     if ($numitems) {
                   11757:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  11758:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11759:             my $path = $env{'form.archive_content_'.$i};
                   11760:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11761:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11762:                     if ($prefix ne '' && $path ne '') {
                   11763:                         if (-e $prefix.$path) {
1.1066    raeburn  11764:                             if ((@archdirs > 0) && 
                   11765:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11766:                                 $todeletedir{$prefix.$path} = 1;
                   11767:                             } else {
                   11768:                                 $todelete{$prefix.$path} = 1;
                   11769:                             }
1.1055    raeburn  11770:                         }
                   11771:                     }
                   11772:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11773:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11774:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11775:                     $docstitle = $env{'form.archive_title_'.$i};
                   11776:                     if ($docstitle eq '') {
                   11777:                         $docstitle = $title;
                   11778:                     }
1.1055    raeburn  11779:                     $outer = 0;
1.1056    raeburn  11780:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11781:                         if (@{$dirorder{$i}} > 0) {
                   11782:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11783:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11784:                                     $outer = $item;
                   11785:                                     last;
                   11786:                                 }
                   11787:                             }
                   11788:                         }
                   11789:                     }
                   11790:                     my ($errtext,$fatal) = 
                   11791:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11792:                                                '/'.$folders{$outer}.'.'.
                   11793:                                                $containers{$outer});
                   11794:                     next if ($fatal);
                   11795:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11796:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11797:                             $mapinner{$i} = time;
1.1055    raeburn  11798:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11799:                             $containers{$i} = 'sequence';
                   11800:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11801:                                       $folders{$i}.'.'.$containers{$i};
                   11802:                             my $newidx = &LONCAPA::map::getresidx();
                   11803:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11804:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11805:                             push(@LONCAPA::map::order,$newidx);
                   11806:                             my ($outtext,$errtext) =
                   11807:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11808:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  11809:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11810:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11811:                             unless ($errtext) {
                   11812:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11813:                             }
1.1055    raeburn  11814:                         }
                   11815:                     } else {
                   11816:                         if ($context eq 'coursedocs') {
                   11817:                             my $newidx=&LONCAPA::map::getresidx();
                   11818:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11819:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11820:                                       $title;
                   11821:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11822:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11823:                             }
                   11824:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11825:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11826:                             }
                   11827:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11828:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11829:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11830:                                 unless ($ishome) {
                   11831:                                     my $fetch = "$newdest{$i}/$title";
                   11832:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11833:                                     $prompttofetch{$fetch} = 1;
                   11834:                                 }
1.1055    raeburn  11835:                             }
                   11836:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11837:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11838:                             push(@LONCAPA::map::order, $newidx);
                   11839:                             my ($outtext,$errtext)=
                   11840:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11841:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  11842:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11843:                             unless ($errtext) {
                   11844:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11845:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11846:                                 }
                   11847:                             }
1.1055    raeburn  11848:                         }
                   11849:                     }
1.1086    raeburn  11850:                 }
                   11851:             } else {
                   11852:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   11853:             }
                   11854:         }
                   11855:         for (my $i=1; $i<=$numitems; $i++) {
                   11856:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11857:             my $path = $env{'form.archive_content_'.$i};
                   11858:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11859:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11860:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11861:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11862:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11863:                         my ($itemidx,$fullpath,$relpath);
                   11864:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11865:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11866:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  11867:                                 if ($dirorder{$i}->[$j] eq $container) {
                   11868:                                     $itemidx = $j;
1.1056    raeburn  11869:                                 }
                   11870:                             }
1.1086    raeburn  11871:                         }
                   11872:                         if ($itemidx eq '') {
                   11873:                             $itemidx =  0;
                   11874:                         } 
                   11875:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   11876:                             if ($mapinner{$referrer{$i}}) {
                   11877:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   11878:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11879:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11880:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11881:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11882:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11883:                                             if (!-e $fullpath) {
                   11884:                                                 mkdir($fullpath,0755);
1.1056    raeburn  11885:                                             }
                   11886:                                         }
1.1086    raeburn  11887:                                     } else {
                   11888:                                         last;
1.1056    raeburn  11889:                                     }
1.1086    raeburn  11890:                                 }
                   11891:                             }
                   11892:                         } elsif ($newdest{$referrer{$i}}) {
                   11893:                             $fullpath = $newdest{$referrer{$i}};
                   11894:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11895:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   11896:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   11897:                                     last;
                   11898:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11899:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11900:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11901:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11902:                                         if (!-e $fullpath) {
                   11903:                                             mkdir($fullpath,0755);
1.1056    raeburn  11904:                                         }
                   11905:                                     }
1.1086    raeburn  11906:                                 } else {
                   11907:                                     last;
1.1056    raeburn  11908:                                 }
1.1055    raeburn  11909:                             }
                   11910:                         }
1.1086    raeburn  11911:                         if ($fullpath ne '') {
                   11912:                             if (-e "$prefix$path") {
                   11913:                                 system("mv $prefix$path $fullpath/$title");
                   11914:                             }
                   11915:                             if (-e "$fullpath/$title") {
                   11916:                                 my $showpath;
                   11917:                                 if ($relpath ne '') {
                   11918:                                     $showpath = "$relpath/$title";
                   11919:                                 } else {
                   11920:                                     $showpath = "/$title";
                   11921:                                 } 
                   11922:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   11923:                             } 
                   11924:                             unless ($ishome) {
                   11925:                                 my $fetch = "$fullpath/$title";
                   11926:                                 $fetch =~ s/^\Q$prefix$dir\E//; 
                   11927:                                 $prompttofetch{$fetch} = 1;
                   11928:                             }
                   11929:                         }
1.1055    raeburn  11930:                     }
1.1086    raeburn  11931:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   11932:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   11933:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  11934:                 }
                   11935:             } else {
                   11936:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   11937:             }
                   11938:         }
                   11939:         if (keys(%todelete)) {
                   11940:             foreach my $key (keys(%todelete)) {
                   11941:                 unlink($key);
1.1066    raeburn  11942:             }
                   11943:         }
                   11944:         if (keys(%todeletedir)) {
                   11945:             foreach my $key (keys(%todeletedir)) {
                   11946:                 rmdir($key);
                   11947:             }
                   11948:         }
                   11949:         foreach my $dir (sort(keys(%is_dir))) {
                   11950:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   11951:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  11952:             }
                   11953:         }
1.1067    raeburn  11954:         if ($result ne '') {
                   11955:             $output .= '<ul>'."\n".
                   11956:                        $result."\n".
                   11957:                        '</ul>';
                   11958:         }
                   11959:         unless ($ishome) {
                   11960:             my $replicationfail;
                   11961:             foreach my $item (keys(%prompttofetch)) {
                   11962:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   11963:                 unless ($fetchresult eq 'ok') {
                   11964:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   11965:                 }
                   11966:             }
                   11967:             if ($replicationfail) {
                   11968:                 $output .= '<p class="LC_error">'.
                   11969:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   11970:                            $replicationfail.
                   11971:                            '</ul></p>';
                   11972:             }
                   11973:         }
1.1055    raeburn  11974:     } else {
                   11975:         $warning = &mt('No items found in archive.');
                   11976:     }
                   11977:     if ($error) {
                   11978:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11979:                    $error.'</p>'."\n";
                   11980:     }
                   11981:     if ($warning) {
                   11982:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11983:     }
                   11984:     return $output;
                   11985: }
                   11986: 
1.1066    raeburn  11987: sub cleanup_empty_dirs {
                   11988:     my ($path) = @_;
                   11989:     if (($path ne '') && (-d $path)) {
                   11990:         if (opendir(my $dirh,$path)) {
                   11991:             my @dircontents = grep(!/^\./,readdir($dirh));
                   11992:             my $numitems = 0;
                   11993:             foreach my $item (@dircontents) {
                   11994:                 if (-d "$path/$item") {
1.1111    raeburn  11995:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  11996:                     if (-e "$path/$item") {
                   11997:                         $numitems ++;
                   11998:                     }
                   11999:                 } else {
                   12000:                     $numitems ++;
                   12001:                 }
                   12002:             }
                   12003:             if ($numitems == 0) {
                   12004:                 rmdir($path);
                   12005:             }
                   12006:             closedir($dirh);
                   12007:         }
                   12008:     }
                   12009:     return;
                   12010: }
                   12011: 
1.41      ng       12012: =pod
1.45      matthew  12013: 
1.1068    raeburn  12014: =item &get_folder_hierarchy()
                   12015: 
                   12016: Provides hierarchy of names of folders/sub-folders containing the current
                   12017: item,
                   12018: 
                   12019: Inputs: 3
                   12020:      - $navmap - navmaps object
                   12021: 
                   12022:      - $map - url for map (either the trigger itself, or map containing
                   12023:                            the resource, which is the trigger).
                   12024: 
                   12025:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12026: 
                   12027: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12028: 
                   12029: =cut
                   12030: 
                   12031: sub get_folder_hierarchy {
                   12032:     my ($navmap,$map,$showitem) = @_;
                   12033:     my @pathitems;
                   12034:     if (ref($navmap)) {
                   12035:         my $mapres = $navmap->getResourceByUrl($map);
                   12036:         if (ref($mapres)) {
                   12037:             my $pcslist = $mapres->map_hierarchy();
                   12038:             if ($pcslist ne '') {
                   12039:                 my @pcs = split(/,/,$pcslist);
                   12040:                 foreach my $pc (@pcs) {
                   12041:                     if ($pc == 1) {
1.1129    raeburn  12042:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12043:                     } else {
                   12044:                         my $res = $navmap->getByMapPc($pc);
                   12045:                         if (ref($res)) {
                   12046:                             my $title = $res->compTitle();
                   12047:                             $title =~ s/\W+/_/g;
                   12048:                             if ($title ne '') {
                   12049:                                 push(@pathitems,$title);
                   12050:                             }
                   12051:                         }
                   12052:                     }
                   12053:                 }
                   12054:             }
1.1071    raeburn  12055:             if ($showitem) {
                   12056:                 if ($mapres->{ID} eq '0.0') {
1.1129    raeburn  12057:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12058:                 } else {
                   12059:                     my $maptitle = $mapres->compTitle();
                   12060:                     $maptitle =~ s/\W+/_/g;
                   12061:                     if ($maptitle ne '') {
                   12062:                         push(@pathitems,$maptitle);
                   12063:                     }
1.1068    raeburn  12064:                 }
                   12065:             }
                   12066:         }
                   12067:     }
                   12068:     return @pathitems;
                   12069: }
                   12070: 
                   12071: =pod
                   12072: 
1.1015    raeburn  12073: =item * &get_turnedin_filepath()
                   12074: 
                   12075: Determines path in a user's portfolio file for storage of files uploaded
                   12076: to a specific essayresponse or dropbox item.
                   12077: 
                   12078: Inputs: 3 required + 1 optional.
                   12079: $symb is symb for resource, $uname and $udom are for current user (required).
                   12080: $caller is optional (can be "submission", if routine is called when storing
                   12081: an upoaded file when "Submit Answer" button was pressed).
                   12082: 
                   12083: Returns array containing $path and $multiresp. 
                   12084: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12085: than one file upload item.  Callers of routine should append partid as a 
                   12086: subdirectory to $path in cases where $multiresp is 1.
                   12087: 
                   12088: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12089: 
                   12090: =cut
                   12091: 
                   12092: sub get_turnedin_filepath {
                   12093:     my ($symb,$uname,$udom,$caller) = @_;
                   12094:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12095:     my $turnindir;
                   12096:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12097:     $turnindir = $userhash{'turnindir'};
                   12098:     my ($path,$multiresp);
                   12099:     if ($turnindir eq '') {
                   12100:         if ($caller eq 'submission') {
                   12101:             $turnindir = &mt('turned in');
                   12102:             $turnindir =~ s/\W+/_/g;
                   12103:             my %newhash = (
                   12104:                             'turnindir' => $turnindir,
                   12105:                           );
                   12106:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12107:         }
                   12108:     }
                   12109:     if ($turnindir ne '') {
                   12110:         $path = '/'.$turnindir.'/';
                   12111:         my ($multipart,$turnin,@pathitems);
                   12112:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12113:         if (defined($navmap)) {
                   12114:             my $mapres = $navmap->getResourceByUrl($map);
                   12115:             if (ref($mapres)) {
                   12116:                 my $pcslist = $mapres->map_hierarchy();
                   12117:                 if ($pcslist ne '') {
                   12118:                     foreach my $pc (split(/,/,$pcslist)) {
                   12119:                         my $res = $navmap->getByMapPc($pc);
                   12120:                         if (ref($res)) {
                   12121:                             my $title = $res->compTitle();
                   12122:                             $title =~ s/\W+/_/g;
                   12123:                             if ($title ne '') {
                   12124:                                 push(@pathitems,$title);
                   12125:                             }
                   12126:                         }
                   12127:                     }
                   12128:                 }
                   12129:                 my $maptitle = $mapres->compTitle();
                   12130:                 $maptitle =~ s/\W+/_/g;
                   12131:                 if ($maptitle ne '') {
                   12132:                     push(@pathitems,$maptitle);
                   12133:                 }
                   12134:                 unless ($env{'request.state'} eq 'construct') {
                   12135:                     my $res = $navmap->getBySymb($symb);
                   12136:                     if (ref($res)) {
                   12137:                         my $partlist = $res->parts();
                   12138:                         my $totaluploads = 0;
                   12139:                         if (ref($partlist) eq 'ARRAY') {
                   12140:                             foreach my $part (@{$partlist}) {
                   12141:                                 my @types = $res->responseType($part);
                   12142:                                 my @ids = $res->responseIds($part);
                   12143:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12144:                                     if ($types[$i] eq 'essay') {
                   12145:                                         my $partid = $part.'_'.$ids[$i];
                   12146:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12147:                                             $totaluploads ++;
                   12148:                                         }
                   12149:                                     }
                   12150:                                 }
                   12151:                             }
                   12152:                             if ($totaluploads > 1) {
                   12153:                                 $multiresp = 1;
                   12154:                             }
                   12155:                         }
                   12156:                     }
                   12157:                 }
                   12158:             } else {
                   12159:                 return;
                   12160:             }
                   12161:         } else {
                   12162:             return;
                   12163:         }
                   12164:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12165:         $restitle =~ s/\W+/_/g;
                   12166:         if ($restitle eq '') {
                   12167:             $restitle = ($resurl =~ m{/[^/]+$});
                   12168:             if ($restitle eq '') {
                   12169:                 $restitle = time;
                   12170:             }
                   12171:         }
                   12172:         push(@pathitems,$restitle);
                   12173:         $path .= join('/',@pathitems);
                   12174:     }
                   12175:     return ($path,$multiresp);
                   12176: }
                   12177: 
                   12178: =pod
                   12179: 
1.464     albertel 12180: =back
1.41      ng       12181: 
1.112     bowersj2 12182: =head1 CSV Upload/Handling functions
1.38      albertel 12183: 
1.41      ng       12184: =over 4
                   12185: 
1.648     raeburn  12186: =item * &upfile_store($r)
1.41      ng       12187: 
                   12188: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12189: needs $env{'form.upfile'}
1.41      ng       12190: returns $datatoken to be put into hidden field
                   12191: 
                   12192: =cut
1.31      albertel 12193: 
                   12194: sub upfile_store {
                   12195:     my $r=shift;
1.258     albertel 12196:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12197:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12198:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12199:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12200: 
1.258     albertel 12201:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12202: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12203:     {
1.158     raeburn  12204:         my $datafile = $r->dir_config('lonDaemons').
                   12205:                            '/tmp/'.$datatoken.'.tmp';
                   12206:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12207:             print $fh $env{'form.upfile'};
1.158     raeburn  12208:             close($fh);
                   12209:         }
1.31      albertel 12210:     }
                   12211:     return $datatoken;
                   12212: }
                   12213: 
1.56      matthew  12214: =pod
                   12215: 
1.648     raeburn  12216: =item * &load_tmp_file($r)
1.41      ng       12217: 
                   12218: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12219: needs $env{'form.datatoken'},
                   12220: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12221: 
                   12222: =cut
1.31      albertel 12223: 
                   12224: sub load_tmp_file {
                   12225:     my $r=shift;
                   12226:     my @studentdata=();
                   12227:     {
1.158     raeburn  12228:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12229:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12230:         if ( open(my $fh,"<$studentfile") ) {
                   12231:             @studentdata=<$fh>;
                   12232:             close($fh);
                   12233:         }
1.31      albertel 12234:     }
1.258     albertel 12235:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12236: }
                   12237: 
1.56      matthew  12238: =pod
                   12239: 
1.648     raeburn  12240: =item * &upfile_record_sep()
1.41      ng       12241: 
                   12242: Separate uploaded file into records
                   12243: returns array of records,
1.258     albertel 12244: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12245: 
                   12246: =cut
1.31      albertel 12247: 
                   12248: sub upfile_record_sep {
1.258     albertel 12249:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12250:     } else {
1.248     albertel 12251: 	my @records;
1.258     albertel 12252: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12253: 	    if ($line=~/^\s*$/) { next; }
                   12254: 	    push(@records,$line);
                   12255: 	}
                   12256: 	return @records;
1.31      albertel 12257:     }
                   12258: }
                   12259: 
1.56      matthew  12260: =pod
                   12261: 
1.648     raeburn  12262: =item * &record_sep($record)
1.41      ng       12263: 
1.258     albertel 12264: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12265: 
                   12266: =cut
                   12267: 
1.263     www      12268: sub takeleft {
                   12269:     my $index=shift;
                   12270:     return substr('0000'.$index,-4,4);
                   12271: }
                   12272: 
1.31      albertel 12273: sub record_sep {
                   12274:     my $record=shift;
                   12275:     my %components=();
1.258     albertel 12276:     if ($env{'form.upfiletype'} eq 'xml') {
                   12277:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12278:         my $i=0;
1.356     albertel 12279:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12280:             $field=~s/^(\"|\')//;
                   12281:             $field=~s/(\"|\')$//;
1.263     www      12282:             $components{&takeleft($i)}=$field;
1.31      albertel 12283:             $i++;
                   12284:         }
1.258     albertel 12285:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12286:         my $i=0;
1.356     albertel 12287:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12288:             $field=~s/^(\"|\')//;
                   12289:             $field=~s/(\"|\')$//;
1.263     www      12290:             $components{&takeleft($i)}=$field;
1.31      albertel 12291:             $i++;
                   12292:         }
                   12293:     } else {
1.561     www      12294:         my $separator=',';
1.480     banghart 12295:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12296:             $separator=';';
1.480     banghart 12297:         }
1.31      albertel 12298:         my $i=0;
1.561     www      12299: # the character we are looking for to indicate the end of a quote or a record 
                   12300:         my $looking_for=$separator;
                   12301: # do not add the characters to the fields
                   12302:         my $ignore=0;
                   12303: # we just encountered a separator (or the beginning of the record)
                   12304:         my $just_found_separator=1;
                   12305: # store the field we are working on here
                   12306:         my $field='';
                   12307: # work our way through all characters in record
                   12308:         foreach my $character ($record=~/(.)/g) {
                   12309:             if ($character eq $looking_for) {
                   12310:                if ($character ne $separator) {
                   12311: # Found the end of a quote, again looking for separator
                   12312:                   $looking_for=$separator;
                   12313:                   $ignore=1;
                   12314:                } else {
                   12315: # Found a separator, store away what we got
                   12316:                   $components{&takeleft($i)}=$field;
                   12317: 	          $i++;
                   12318:                   $just_found_separator=1;
                   12319:                   $ignore=0;
                   12320:                   $field='';
                   12321:                }
                   12322:                next;
                   12323:             }
                   12324: # single or double quotation marks after a separator indicate beginning of a quote
                   12325: # we are now looking for the end of the quote and need to ignore separators
                   12326:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12327:                $looking_for=$character;
                   12328:                next;
                   12329:             }
                   12330: # ignore would be true after we reached the end of a quote
                   12331:             if ($ignore) { next; }
                   12332:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   12333:             $field.=$character;
                   12334:             $just_found_separator=0; 
1.31      albertel 12335:         }
1.561     www      12336: # catch the very last entry, since we never encountered the separator
                   12337:         $components{&takeleft($i)}=$field;
1.31      albertel 12338:     }
                   12339:     return %components;
                   12340: }
                   12341: 
1.144     matthew  12342: ######################################################
                   12343: ######################################################
                   12344: 
1.56      matthew  12345: =pod
                   12346: 
1.648     raeburn  12347: =item * &upfile_select_html()
1.41      ng       12348: 
1.144     matthew  12349: Return HTML code to select a file from the users machine and specify 
                   12350: the file type.
1.41      ng       12351: 
                   12352: =cut
                   12353: 
1.144     matthew  12354: ######################################################
                   12355: ######################################################
1.31      albertel 12356: sub upfile_select_html {
1.144     matthew  12357:     my %Types = (
                   12358:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 12359:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  12360:                  space => &mt('Space separated'),
                   12361:                  tab   => &mt('Tabulator separated'),
                   12362: #                 xml   => &mt('HTML/XML'),
                   12363:                  );
                   12364:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  12365:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  12366:     foreach my $type (sort(keys(%Types))) {
                   12367:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   12368:     }
                   12369:     $Str .= "</select>\n";
                   12370:     return $Str;
1.31      albertel 12371: }
                   12372: 
1.301     albertel 12373: sub get_samples {
                   12374:     my ($records,$toget) = @_;
                   12375:     my @samples=({});
                   12376:     my $got=0;
                   12377:     foreach my $rec (@$records) {
                   12378: 	my %temp = &record_sep($rec);
                   12379: 	if (! grep(/\S/, values(%temp))) { next; }
                   12380: 	if (%temp) {
                   12381: 	    $samples[$got]=\%temp;
                   12382: 	    $got++;
                   12383: 	    if ($got == $toget) { last; }
                   12384: 	}
                   12385:     }
                   12386:     return \@samples;
                   12387: }
                   12388: 
1.144     matthew  12389: ######################################################
                   12390: ######################################################
                   12391: 
1.56      matthew  12392: =pod
                   12393: 
1.648     raeburn  12394: =item * &csv_print_samples($r,$records)
1.41      ng       12395: 
                   12396: Prints a table of sample values from each column uploaded $r is an
                   12397: Apache Request ref, $records is an arrayref from
                   12398: &Apache::loncommon::upfile_record_sep
                   12399: 
                   12400: =cut
                   12401: 
1.144     matthew  12402: ######################################################
                   12403: ######################################################
1.31      albertel 12404: sub csv_print_samples {
                   12405:     my ($r,$records) = @_;
1.662     bisitz   12406:     my $samples = &get_samples($records,5);
1.301     albertel 12407: 
1.594     raeburn  12408:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12409:               &start_data_table_header_row());
1.356     albertel 12410:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12411:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12412:     $r->print(&end_data_table_header_row());
1.301     albertel 12413:     foreach my $hash (@$samples) {
1.594     raeburn  12414: 	$r->print(&start_data_table_row());
1.356     albertel 12415: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12416: 	    $r->print('<td>');
1.356     albertel 12417: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12418: 	    $r->print('</td>');
                   12419: 	}
1.594     raeburn  12420: 	$r->print(&end_data_table_row());
1.31      albertel 12421:     }
1.594     raeburn  12422:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12423: }
                   12424: 
1.144     matthew  12425: ######################################################
                   12426: ######################################################
                   12427: 
1.56      matthew  12428: =pod
                   12429: 
1.648     raeburn  12430: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12431: 
                   12432: Prints a table to create associations between values and table columns.
1.144     matthew  12433: 
1.41      ng       12434: $r is an Apache Request ref,
                   12435: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12436: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12437: 
                   12438: =cut
                   12439: 
1.144     matthew  12440: ######################################################
                   12441: ######################################################
1.31      albertel 12442: sub csv_print_select_table {
                   12443:     my ($r,$records,$d) = @_;
1.301     albertel 12444:     my $i=0;
                   12445:     my $samples = &get_samples($records,1);
1.144     matthew  12446:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12447: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12448:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12449:               '<th>'.&mt('Column').'</th>'.
                   12450:               &end_data_table_header_row()."\n");
1.356     albertel 12451:     foreach my $array_ref (@$d) {
                   12452: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12453: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12454: 
1.875     bisitz   12455: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12456: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12457: 	$r->print('<option value="none"></option>');
1.356     albertel 12458: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12459: 	    $r->print('<option value="'.$sample.'"'.
                   12460:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12461:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12462: 	}
1.594     raeburn  12463: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12464: 	$i++;
                   12465:     }
1.594     raeburn  12466:     $r->print(&end_data_table());
1.31      albertel 12467:     $i--;
                   12468:     return $i;
                   12469: }
1.56      matthew  12470: 
1.144     matthew  12471: ######################################################
                   12472: ######################################################
                   12473: 
1.56      matthew  12474: =pod
1.31      albertel 12475: 
1.648     raeburn  12476: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12477: 
                   12478: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12479: 
                   12480: $r is an Apache Request ref,
                   12481: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12482: $d is an array of 2 element arrays (internal name, displayed name)
                   12483: 
                   12484: =cut
                   12485: 
1.144     matthew  12486: ######################################################
                   12487: ######################################################
1.31      albertel 12488: sub csv_samples_select_table {
                   12489:     my ($r,$records,$d) = @_;
                   12490:     my $i=0;
1.144     matthew  12491:     #
1.662     bisitz   12492:     my $max_samples = 5;
                   12493:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12494:     $r->print(&start_data_table().
                   12495:               &start_data_table_header_row().'<th>'.
                   12496:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12497:               &end_data_table_header_row());
1.301     albertel 12498: 
                   12499:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12500: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12501: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12502: 	foreach my $option (@$d) {
                   12503: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12504: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12505:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12506:                       $display.'</option>');
1.31      albertel 12507: 	}
                   12508: 	$r->print('</select></td><td>');
1.662     bisitz   12509: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12510: 	    if (defined($samples->[$line]{$key})) { 
                   12511: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12512: 	    }
                   12513: 	}
1.594     raeburn  12514: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12515: 	$i++;
                   12516:     }
1.594     raeburn  12517:     $r->print(&end_data_table());
1.31      albertel 12518:     $i--;
                   12519:     return($i);
1.115     matthew  12520: }
                   12521: 
1.144     matthew  12522: ######################################################
                   12523: ######################################################
                   12524: 
1.115     matthew  12525: =pod
                   12526: 
1.648     raeburn  12527: =item * &clean_excel_name($name)
1.115     matthew  12528: 
                   12529: Returns a replacement for $name which does not contain any illegal characters.
                   12530: 
                   12531: =cut
                   12532: 
1.144     matthew  12533: ######################################################
                   12534: ######################################################
1.115     matthew  12535: sub clean_excel_name {
                   12536:     my ($name) = @_;
                   12537:     $name =~ s/[:\*\?\/\\]//g;
                   12538:     if (length($name) > 31) {
                   12539:         $name = substr($name,0,31);
                   12540:     }
                   12541:     return $name;
1.25      albertel 12542: }
1.84      albertel 12543: 
1.85      albertel 12544: =pod
                   12545: 
1.648     raeburn  12546: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12547: 
                   12548: Returns either 1 or undef
                   12549: 
                   12550: 1 if the part is to be hidden, undef if it is to be shown
                   12551: 
                   12552: Arguments are:
                   12553: 
                   12554: $id the id of the part to be checked
                   12555: $symb, optional the symb of the resource to check
                   12556: $udom, optional the domain of the user to check for
                   12557: $uname, optional the username of the user to check for
                   12558: 
                   12559: =cut
1.84      albertel 12560: 
                   12561: sub check_if_partid_hidden {
                   12562:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12563:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12564: 					 $symb,$udom,$uname);
1.141     albertel 12565:     my $truth=1;
                   12566:     #if the string starts with !, then the list is the list to show not hide
                   12567:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12568:     my @hiddenlist=split(/,/,$hiddenparts);
                   12569:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12570: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12571:     }
1.141     albertel 12572:     return !$truth;
1.84      albertel 12573: }
1.127     matthew  12574: 
1.138     matthew  12575: 
                   12576: ############################################################
                   12577: ############################################################
                   12578: 
                   12579: =pod
                   12580: 
1.157     matthew  12581: =back 
                   12582: 
1.138     matthew  12583: =head1 cgi-bin script and graphing routines
                   12584: 
1.157     matthew  12585: =over 4
                   12586: 
1.648     raeburn  12587: =item * &get_cgi_id()
1.138     matthew  12588: 
                   12589: Inputs: none
                   12590: 
                   12591: Returns an id which can be used to pass environment variables
                   12592: to various cgi-bin scripts.  These environment variables will
                   12593: be removed from the users environment after a given time by
                   12594: the routine &Apache::lonnet::transfer_profile_to_env.
                   12595: 
                   12596: =cut
                   12597: 
                   12598: ############################################################
                   12599: ############################################################
1.152     albertel 12600: my $uniq=0;
1.136     matthew  12601: sub get_cgi_id {
1.154     albertel 12602:     $uniq=($uniq+1)%100000;
1.280     albertel 12603:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12604: }
                   12605: 
1.127     matthew  12606: ############################################################
                   12607: ############################################################
                   12608: 
                   12609: =pod
                   12610: 
1.648     raeburn  12611: =item * &DrawBarGraph()
1.127     matthew  12612: 
1.138     matthew  12613: Facilitates the plotting of data in a (stacked) bar graph.
                   12614: Puts plot definition data into the users environment in order for 
                   12615: graph.png to plot it.  Returns an <img> tag for the plot.
                   12616: The bars on the plot are labeled '1','2',...,'n'.
                   12617: 
                   12618: Inputs:
                   12619: 
                   12620: =over 4
                   12621: 
                   12622: =item $Title: string, the title of the plot
                   12623: 
                   12624: =item $xlabel: string, text describing the X-axis of the plot
                   12625: 
                   12626: =item $ylabel: string, text describing the Y-axis of the plot
                   12627: 
                   12628: =item $Max: scalar, the maximum Y value to use in the plot
                   12629: If $Max is < any data point, the graph will not be rendered.
                   12630: 
1.140     matthew  12631: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12632: they are plotted.  If undefined, default values will be used.
                   12633: 
1.178     matthew  12634: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12635: 
1.138     matthew  12636: =item @Values: An array of array references.  Each array reference holds data
                   12637: to be plotted in a stacked bar chart.
                   12638: 
1.239     matthew  12639: =item If the final element of @Values is a hash reference the key/value
                   12640: pairs will be added to the graph definition.
                   12641: 
1.138     matthew  12642: =back
                   12643: 
                   12644: Returns:
                   12645: 
                   12646: An <img> tag which references graph.png and the appropriate identifying
                   12647: information for the plot.
                   12648: 
1.127     matthew  12649: =cut
                   12650: 
                   12651: ############################################################
                   12652: ############################################################
1.134     matthew  12653: sub DrawBarGraph {
1.178     matthew  12654:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12655:     #
                   12656:     if (! defined($colors)) {
                   12657:         $colors = ['#33ff00', 
                   12658:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12659:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12660:                   ]; 
                   12661:     }
1.228     matthew  12662:     my $extra_settings = {};
                   12663:     if (ref($Values[-1]) eq 'HASH') {
                   12664:         $extra_settings = pop(@Values);
                   12665:     }
1.127     matthew  12666:     #
1.136     matthew  12667:     my $identifier = &get_cgi_id();
                   12668:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12669:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12670:         return '';
                   12671:     }
1.225     matthew  12672:     #
                   12673:     my @Labels;
                   12674:     if (defined($labels)) {
                   12675:         @Labels = @$labels;
                   12676:     } else {
                   12677:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12678:             push (@Labels,$i+1);
                   12679:         }
                   12680:     }
                   12681:     #
1.129     matthew  12682:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12683:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12684:     my %ValuesHash;
                   12685:     my $NumSets=1;
                   12686:     foreach my $array (@Values) {
                   12687:         next if (! ref($array));
1.136     matthew  12688:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12689:             join(',',@$array);
1.129     matthew  12690:     }
1.127     matthew  12691:     #
1.136     matthew  12692:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12693:     if ($NumBars < 3) {
                   12694:         $width = 120+$NumBars*32;
1.220     matthew  12695:         $xskip = 1;
1.225     matthew  12696:         $bar_width = 30;
                   12697:     } elsif ($NumBars < 5) {
                   12698:         $width = 120+$NumBars*20;
                   12699:         $xskip = 1;
                   12700:         $bar_width = 20;
1.220     matthew  12701:     } elsif ($NumBars < 10) {
1.136     matthew  12702:         $width = 120+$NumBars*15;
                   12703:         $xskip = 1;
                   12704:         $bar_width = 15;
                   12705:     } elsif ($NumBars <= 25) {
                   12706:         $width = 120+$NumBars*11;
                   12707:         $xskip = 5;
                   12708:         $bar_width = 8;
                   12709:     } elsif ($NumBars <= 50) {
                   12710:         $width = 120+$NumBars*8;
                   12711:         $xskip = 5;
                   12712:         $bar_width = 4;
                   12713:     } else {
                   12714:         $width = 120+$NumBars*8;
                   12715:         $xskip = 5;
                   12716:         $bar_width = 4;
                   12717:     }
                   12718:     #
1.137     matthew  12719:     $Max = 1 if ($Max < 1);
                   12720:     if ( int($Max) < $Max ) {
                   12721:         $Max++;
                   12722:         $Max = int($Max);
                   12723:     }
1.127     matthew  12724:     $Title  = '' if (! defined($Title));
                   12725:     $xlabel = '' if (! defined($xlabel));
                   12726:     $ylabel = '' if (! defined($ylabel));
1.369     www      12727:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12728:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12729:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12730:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12731:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12732:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12733:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12734:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12735:     $ValuesHash{$id.'.height'}   = $height;
                   12736:     $ValuesHash{$id.'.width'}    = $width;
                   12737:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12738:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12739:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12740:     #
1.228     matthew  12741:     # Deal with other parameters
                   12742:     while (my ($key,$value) = each(%$extra_settings)) {
                   12743:         $ValuesHash{$id.'.'.$key} = $value;
                   12744:     }
                   12745:     #
1.646     raeburn  12746:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12747:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12748: }
                   12749: 
                   12750: ############################################################
                   12751: ############################################################
                   12752: 
                   12753: =pod
                   12754: 
1.648     raeburn  12755: =item * &DrawXYGraph()
1.137     matthew  12756: 
1.138     matthew  12757: Facilitates the plotting of data in an XY graph.
                   12758: Puts plot definition data into the users environment in order for 
                   12759: graph.png to plot it.  Returns an <img> tag for the plot.
                   12760: 
                   12761: Inputs:
                   12762: 
                   12763: =over 4
                   12764: 
                   12765: =item $Title: string, the title of the plot
                   12766: 
                   12767: =item $xlabel: string, text describing the X-axis of the plot
                   12768: 
                   12769: =item $ylabel: string, text describing the Y-axis of the plot
                   12770: 
                   12771: =item $Max: scalar, the maximum Y value to use in the plot
                   12772: If $Max is < any data point, the graph will not be rendered.
                   12773: 
                   12774: =item $colors: Array ref containing the hex color codes for the data to be 
                   12775: plotted in.  If undefined, default values will be used.
                   12776: 
                   12777: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12778: 
                   12779: =item $Ydata: Array ref containing Array refs.  
1.185     www      12780: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12781: 
                   12782: =item %Values: hash indicating or overriding any default values which are 
                   12783: passed to graph.png.  
                   12784: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12785: 
                   12786: =back
                   12787: 
                   12788: Returns:
                   12789: 
                   12790: An <img> tag which references graph.png and the appropriate identifying
                   12791: information for the plot.
                   12792: 
1.137     matthew  12793: =cut
                   12794: 
                   12795: ############################################################
                   12796: ############################################################
                   12797: sub DrawXYGraph {
                   12798:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12799:     #
                   12800:     # Create the identifier for the graph
                   12801:     my $identifier = &get_cgi_id();
                   12802:     my $id = 'cgi.'.$identifier;
                   12803:     #
                   12804:     $Title  = '' if (! defined($Title));
                   12805:     $xlabel = '' if (! defined($xlabel));
                   12806:     $ylabel = '' if (! defined($ylabel));
                   12807:     my %ValuesHash = 
                   12808:         (
1.369     www      12809:          $id.'.title'  => &escape($Title),
                   12810:          $id.'.xlabel' => &escape($xlabel),
                   12811:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12812:          $id.'.y_max_value'=> $Max,
                   12813:          $id.'.labels'     => join(',',@$Xlabels),
                   12814:          $id.'.PlotType'   => 'XY',
                   12815:          );
                   12816:     #
                   12817:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12818:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12819:     }
                   12820:     #
                   12821:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12822:         return '';
                   12823:     }
                   12824:     my $NumSets=1;
1.138     matthew  12825:     foreach my $array (@{$Ydata}){
1.137     matthew  12826:         next if (! ref($array));
                   12827:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12828:     }
1.138     matthew  12829:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12830:     #
                   12831:     # Deal with other parameters
                   12832:     while (my ($key,$value) = each(%Values)) {
                   12833:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12834:     }
                   12835:     #
1.646     raeburn  12836:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12837:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12838: }
                   12839: 
                   12840: ############################################################
                   12841: ############################################################
                   12842: 
                   12843: =pod
                   12844: 
1.648     raeburn  12845: =item * &DrawXYYGraph()
1.138     matthew  12846: 
                   12847: Facilitates the plotting of data in an XY graph with two Y axes.
                   12848: Puts plot definition data into the users environment in order for 
                   12849: graph.png to plot it.  Returns an <img> tag for the plot.
                   12850: 
                   12851: Inputs:
                   12852: 
                   12853: =over 4
                   12854: 
                   12855: =item $Title: string, the title of the plot
                   12856: 
                   12857: =item $xlabel: string, text describing the X-axis of the plot
                   12858: 
                   12859: =item $ylabel: string, text describing the Y-axis of the plot
                   12860: 
                   12861: =item $colors: Array ref containing the hex color codes for the data to be 
                   12862: plotted in.  If undefined, default values will be used.
                   12863: 
                   12864: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12865: 
                   12866: =item $Ydata1: The first data set
                   12867: 
                   12868: =item $Min1: The minimum value of the left Y-axis
                   12869: 
                   12870: =item $Max1: The maximum value of the left Y-axis
                   12871: 
                   12872: =item $Ydata2: The second data set
                   12873: 
                   12874: =item $Min2: The minimum value of the right Y-axis
                   12875: 
                   12876: =item $Max2: The maximum value of the left Y-axis
                   12877: 
                   12878: =item %Values: hash indicating or overriding any default values which are 
                   12879: passed to graph.png.  
                   12880: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12881: 
                   12882: =back
                   12883: 
                   12884: Returns:
                   12885: 
                   12886: An <img> tag which references graph.png and the appropriate identifying
                   12887: information for the plot.
1.136     matthew  12888: 
                   12889: =cut
                   12890: 
                   12891: ############################################################
                   12892: ############################################################
1.137     matthew  12893: sub DrawXYYGraph {
                   12894:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   12895:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  12896:     #
                   12897:     # Create the identifier for the graph
                   12898:     my $identifier = &get_cgi_id();
                   12899:     my $id = 'cgi.'.$identifier;
                   12900:     #
                   12901:     $Title  = '' if (! defined($Title));
                   12902:     $xlabel = '' if (! defined($xlabel));
                   12903:     $ylabel = '' if (! defined($ylabel));
                   12904:     my %ValuesHash = 
                   12905:         (
1.369     www      12906:          $id.'.title'  => &escape($Title),
                   12907:          $id.'.xlabel' => &escape($xlabel),
                   12908:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  12909:          $id.'.labels' => join(',',@$Xlabels),
                   12910:          $id.'.PlotType' => 'XY',
                   12911:          $id.'.NumSets' => 2,
1.137     matthew  12912:          $id.'.two_axes' => 1,
                   12913:          $id.'.y1_max_value' => $Max1,
                   12914:          $id.'.y1_min_value' => $Min1,
                   12915:          $id.'.y2_max_value' => $Max2,
                   12916:          $id.'.y2_min_value' => $Min2,
1.136     matthew  12917:          );
                   12918:     #
1.137     matthew  12919:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12920:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12921:     }
                   12922:     #
                   12923:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   12924:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  12925:         return '';
                   12926:     }
                   12927:     my $NumSets=1;
1.137     matthew  12928:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  12929:         next if (! ref($array));
                   12930:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  12931:     }
                   12932:     #
                   12933:     # Deal with other parameters
                   12934:     while (my ($key,$value) = each(%Values)) {
                   12935:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  12936:     }
                   12937:     #
1.646     raeburn  12938:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 12939:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  12940: }
                   12941: 
                   12942: ############################################################
                   12943: ############################################################
                   12944: 
                   12945: =pod
                   12946: 
1.157     matthew  12947: =back 
                   12948: 
1.139     matthew  12949: =head1 Statistics helper routines?  
                   12950: 
                   12951: Bad place for them but what the hell.
                   12952: 
1.157     matthew  12953: =over 4
                   12954: 
1.648     raeburn  12955: =item * &chartlink()
1.139     matthew  12956: 
                   12957: Returns a link to the chart for a specific student.  
                   12958: 
                   12959: Inputs:
                   12960: 
                   12961: =over 4
                   12962: 
                   12963: =item $linktext: The text of the link
                   12964: 
                   12965: =item $sname: The students username
                   12966: 
                   12967: =item $sdomain: The students domain
                   12968: 
                   12969: =back
                   12970: 
1.157     matthew  12971: =back
                   12972: 
1.139     matthew  12973: =cut
                   12974: 
                   12975: ############################################################
                   12976: ############################################################
                   12977: sub chartlink {
                   12978:     my ($linktext, $sname, $sdomain) = @_;
                   12979:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      12980:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 12981:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  12982:        '">'.$linktext.'</a>';
1.153     matthew  12983: }
                   12984: 
                   12985: #######################################################
                   12986: #######################################################
                   12987: 
                   12988: =pod
                   12989: 
                   12990: =head1 Course Environment Routines
1.157     matthew  12991: 
                   12992: =over 4
1.153     matthew  12993: 
1.648     raeburn  12994: =item * &restore_course_settings()
1.153     matthew  12995: 
1.648     raeburn  12996: =item * &store_course_settings()
1.153     matthew  12997: 
                   12998: Restores/Store indicated form parameters from the course environment.
                   12999: Will not overwrite existing values of the form parameters.
                   13000: 
                   13001: Inputs: 
                   13002: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13003: 
                   13004: a hash ref describing the data to be stored.  For example:
                   13005:    
                   13006: %Save_Parameters = ('Status' => 'scalar',
                   13007:     'chartoutputmode' => 'scalar',
                   13008:     'chartoutputdata' => 'scalar',
                   13009:     'Section' => 'array',
1.373     raeburn  13010:     'Group' => 'array',
1.153     matthew  13011:     'StudentData' => 'array',
                   13012:     'Maps' => 'array');
                   13013: 
                   13014: Returns: both routines return nothing
                   13015: 
1.631     raeburn  13016: =back
                   13017: 
1.153     matthew  13018: =cut
                   13019: 
                   13020: #######################################################
                   13021: #######################################################
                   13022: sub store_course_settings {
1.496     albertel 13023:     return &store_settings($env{'request.course.id'},@_);
                   13024: }
                   13025: 
                   13026: sub store_settings {
1.153     matthew  13027:     # save to the environment
                   13028:     # appenv the same items, just to be safe
1.300     albertel 13029:     my $udom  = $env{'user.domain'};
                   13030:     my $uname = $env{'user.name'};
1.496     albertel 13031:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13032:     my %SaveHash;
                   13033:     my %AppHash;
                   13034:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13035:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13036:         my $envname = 'environment.'.$basename;
1.258     albertel 13037:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13038:             # Save this value away
                   13039:             if ($type eq 'scalar' &&
1.258     albertel 13040:                 (! exists($env{$envname}) || 
                   13041:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13042:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13043:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13044:             } elsif ($type eq 'array') {
                   13045:                 my $stored_form;
1.258     albertel 13046:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13047:                     $stored_form = join(',',
                   13048:                                         map {
1.369     www      13049:                                             &escape($_);
1.258     albertel 13050:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13051:                 } else {
                   13052:                     $stored_form = 
1.369     www      13053:                         &escape($env{'form.'.$setting});
1.153     matthew  13054:                 }
                   13055:                 # Determine if the array contents are the same.
1.258     albertel 13056:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13057:                     $SaveHash{$basename} = $stored_form;
                   13058:                     $AppHash{$envname}   = $stored_form;
                   13059:                 }
                   13060:             }
                   13061:         }
                   13062:     }
                   13063:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13064:                                           $udom,$uname);
1.153     matthew  13065:     if ($put_result !~ /^(ok|delayed)/) {
                   13066:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13067:                                  'got error:'.$put_result);
                   13068:     }
                   13069:     # Make sure these settings stick around in this session, too
1.646     raeburn  13070:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13071:     return;
                   13072: }
                   13073: 
                   13074: sub restore_course_settings {
1.499     albertel 13075:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13076: }
                   13077: 
                   13078: sub restore_settings {
                   13079:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13080:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13081:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13082:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13083:             '.'.$setting;
1.258     albertel 13084:         if (exists($env{$envname})) {
1.153     matthew  13085:             if ($type eq 'scalar') {
1.258     albertel 13086:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13087:             } elsif ($type eq 'array') {
1.258     albertel 13088:                 $env{'form.'.$setting} = [ 
1.153     matthew  13089:                                            map { 
1.369     www      13090:                                                &unescape($_); 
1.258     albertel 13091:                                            } split(',',$env{$envname})
1.153     matthew  13092:                                            ];
                   13093:             }
                   13094:         }
                   13095:     }
1.127     matthew  13096: }
                   13097: 
1.618     raeburn  13098: #######################################################
                   13099: #######################################################
                   13100: 
                   13101: =pod
                   13102: 
                   13103: =head1 Domain E-mail Routines  
                   13104: 
                   13105: =over 4
                   13106: 
1.648     raeburn  13107: =item * &build_recipient_list()
1.618     raeburn  13108: 
1.884     raeburn  13109: Build recipient lists for five types of e-mail:
1.766     raeburn  13110: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.884     raeburn  13111: (d) Help requests, (e) Course requests needing approval,  generated by
                   13112: lonerrorhandler.pm, CHECKRPMS, loncron, lonsupportreq.pm and
                   13113: loncoursequeueadmin.pm respectively.
1.618     raeburn  13114: 
                   13115: Inputs:
1.619     raeburn  13116: defmail (scalar - email address of default recipient), 
1.618     raeburn  13117: mailing type (scalar - errormail, packagesmail, or helpdeskmail), 
1.619     raeburn  13118: defdom (domain for which to retrieve configuration settings),
                   13119: origmail (scalar - email address of recipient from loncapa.conf, 
                   13120: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  13121: 
1.655     raeburn  13122: Returns: comma separated list of addresses to which to send e-mail.
                   13123: 
                   13124: =back
1.618     raeburn  13125: 
                   13126: =cut
                   13127: 
                   13128: ############################################################
                   13129: ############################################################
                   13130: sub build_recipient_list {
1.619     raeburn  13131:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13132:     my @recipients;
                   13133:     my $otheremails;
                   13134:     my %domconfig =
                   13135:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13136:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13137:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13138:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13139:                 my @contacts = ('adminemail','supportemail');
                   13140:                 foreach my $item (@contacts) {
                   13141:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13142:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13143:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13144:                             push(@recipients,$addr);
                   13145:                         }
1.619     raeburn  13146:                     }
1.766     raeburn  13147:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13148:                 }
                   13149:             }
1.766     raeburn  13150:         } elsif ($origmail ne '') {
                   13151:             push(@recipients,$origmail);
1.618     raeburn  13152:         }
1.619     raeburn  13153:     } elsif ($origmail ne '') {
                   13154:         push(@recipients,$origmail);
1.618     raeburn  13155:     }
1.688     raeburn  13156:     if (defined($defmail)) {
                   13157:         if ($defmail ne '') {
                   13158:             push(@recipients,$defmail);
                   13159:         }
1.618     raeburn  13160:     }
                   13161:     if ($otheremails) {
1.619     raeburn  13162:         my @others;
                   13163:         if ($otheremails =~ /,/) {
                   13164:             @others = split(/,/,$otheremails);
1.618     raeburn  13165:         } else {
1.619     raeburn  13166:             push(@others,$otheremails);
                   13167:         }
                   13168:         foreach my $addr (@others) {
                   13169:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13170:                 push(@recipients,$addr);
                   13171:             }
1.618     raeburn  13172:         }
                   13173:     }
1.619     raeburn  13174:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13175:     return $recipientlist;
                   13176: }
                   13177: 
1.127     matthew  13178: ############################################################
                   13179: ############################################################
1.154     albertel 13180: 
1.655     raeburn  13181: =pod
                   13182: 
                   13183: =head1 Course Catalog Routines
                   13184: 
                   13185: =over 4
                   13186: 
                   13187: =item * &gather_categories()
                   13188: 
                   13189: Converts category definitions - keys of categories hash stored in  
                   13190: coursecategories in configuration.db on the primary library server in a 
                   13191: domain - to an array.  Also generates javascript and idx hash used to 
                   13192: generate Domain Coordinator interface for editing Course Categories.
                   13193: 
                   13194: Inputs:
1.663     raeburn  13195: 
1.655     raeburn  13196: categories (reference to hash of category definitions).
1.663     raeburn  13197: 
1.655     raeburn  13198: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13199:       categories and subcategories).
1.663     raeburn  13200: 
1.655     raeburn  13201: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13202:       editing Course Categories).
1.663     raeburn  13203: 
1.655     raeburn  13204: jsarray (reference to array of categories used to create Javascript arrays for
                   13205:          Domain Coordinator interface for editing Course Categories).
                   13206: 
                   13207: Returns: nothing
                   13208: 
                   13209: Side effects: populates cats, idx and jsarray. 
                   13210: 
                   13211: =cut
                   13212: 
                   13213: sub gather_categories {
                   13214:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13215:     my %counters;
                   13216:     my $num = 0;
                   13217:     foreach my $item (keys(%{$categories})) {
                   13218:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13219:         if ($container eq '' && $depth == 0) {
                   13220:             $cats->[$depth][$categories->{$item}] = $cat;
                   13221:         } else {
                   13222:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13223:         }
                   13224:         my ($escitem,$tail) = split(/:/,$item,2);
                   13225:         if ($counters{$tail} eq '') {
                   13226:             $counters{$tail} = $num;
                   13227:             $num ++;
                   13228:         }
                   13229:         if (ref($idx) eq 'HASH') {
                   13230:             $idx->{$item} = $counters{$tail};
                   13231:         }
                   13232:         if (ref($jsarray) eq 'ARRAY') {
                   13233:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13234:         }
                   13235:     }
                   13236:     return;
                   13237: }
                   13238: 
                   13239: =pod
                   13240: 
                   13241: =item * &extract_categories()
                   13242: 
                   13243: Used to generate breadcrumb trails for course categories.
                   13244: 
                   13245: Inputs:
1.663     raeburn  13246: 
1.655     raeburn  13247: categories (reference to hash of category definitions).
1.663     raeburn  13248: 
1.655     raeburn  13249: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13250:       categories and subcategories).
1.663     raeburn  13251: 
1.655     raeburn  13252: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  13253: 
1.655     raeburn  13254: allitems (reference to hash - key is category key 
                   13255:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13256: 
1.655     raeburn  13257: idx (reference to hash of counters used in Domain Coordinator interface for
                   13258:       editing Course Categories).
1.663     raeburn  13259: 
1.655     raeburn  13260: jsarray (reference to array of categories used to create Javascript arrays for
                   13261:          Domain Coordinator interface for editing Course Categories).
                   13262: 
1.665     raeburn  13263: subcats (reference to hash of arrays containing all subcategories within each 
                   13264:          category, -recursive)
                   13265: 
1.655     raeburn  13266: Returns: nothing
                   13267: 
                   13268: Side effects: populates trails and allitems hash references.
                   13269: 
                   13270: =cut
                   13271: 
                   13272: sub extract_categories {
1.665     raeburn  13273:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  13274:     if (ref($categories) eq 'HASH') {
                   13275:         &gather_categories($categories,$cats,$idx,$jsarray);
                   13276:         if (ref($cats->[0]) eq 'ARRAY') {
                   13277:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   13278:                 my $name = $cats->[0][$i];
                   13279:                 my $item = &escape($name).'::0';
                   13280:                 my $trailstr;
                   13281:                 if ($name eq 'instcode') {
                   13282:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  13283:                 } elsif ($name eq 'communities') {
                   13284:                     $trailstr = &mt('Communities');
1.655     raeburn  13285:                 } else {
                   13286:                     $trailstr = $name;
                   13287:                 }
                   13288:                 if ($allitems->{$item} eq '') {
                   13289:                     push(@{$trails},$trailstr);
                   13290:                     $allitems->{$item} = scalar(@{$trails})-1;
                   13291:                 }
                   13292:                 my @parents = ($name);
                   13293:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   13294:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   13295:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  13296:                         if (ref($subcats) eq 'HASH') {
                   13297:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   13298:                         }
                   13299:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   13300:                     }
                   13301:                 } else {
                   13302:                     if (ref($subcats) eq 'HASH') {
                   13303:                         $subcats->{$item} = [];
1.655     raeburn  13304:                     }
                   13305:                 }
                   13306:             }
                   13307:         }
                   13308:     }
                   13309:     return;
                   13310: }
                   13311: 
                   13312: =pod
                   13313: 
                   13314: =item *&recurse_categories()
                   13315: 
                   13316: Recursively used to generate breadcrumb trails for course categories.
                   13317: 
                   13318: Inputs:
1.663     raeburn  13319: 
1.655     raeburn  13320: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13321:       categories and subcategories).
1.663     raeburn  13322: 
1.655     raeburn  13323: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  13324: 
                   13325: category (current course category, for which breadcrumb trail is being generated).
                   13326: 
                   13327: trails (reference to array of breadcrumb trails for each category).
                   13328: 
1.655     raeburn  13329: allitems (reference to hash - key is category key
                   13330:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13331: 
1.655     raeburn  13332: parents (array containing containers directories for current category, 
                   13333:          back to top level). 
                   13334: 
                   13335: Returns: nothing
                   13336: 
                   13337: Side effects: populates trails and allitems hash references
                   13338: 
                   13339: =cut
                   13340: 
                   13341: sub recurse_categories {
1.665     raeburn  13342:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  13343:     my $shallower = $depth - 1;
                   13344:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   13345:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   13346:             my $name = $cats->[$depth]{$category}[$k];
                   13347:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13348:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13349:             if ($allitems->{$item} eq '') {
                   13350:                 push(@{$trails},$trailstr);
                   13351:                 $allitems->{$item} = scalar(@{$trails})-1;
                   13352:             }
                   13353:             my $deeper = $depth+1;
                   13354:             push(@{$parents},$category);
1.665     raeburn  13355:             if (ref($subcats) eq 'HASH') {
                   13356:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   13357:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   13358:                     my $higher;
                   13359:                     if ($j > 0) {
                   13360:                         $higher = &escape($parents->[$j]).':'.
                   13361:                                   &escape($parents->[$j-1]).':'.$j;
                   13362:                     } else {
                   13363:                         $higher = &escape($parents->[$j]).'::'.$j;
                   13364:                     }
                   13365:                     push(@{$subcats->{$higher}},$subcat);
                   13366:                 }
                   13367:             }
                   13368:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   13369:                                 $subcats);
1.655     raeburn  13370:             pop(@{$parents});
                   13371:         }
                   13372:     } else {
                   13373:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13374:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13375:         if ($allitems->{$item} eq '') {
                   13376:             push(@{$trails},$trailstr);
                   13377:             $allitems->{$item} = scalar(@{$trails})-1;
                   13378:         }
                   13379:     }
                   13380:     return;
                   13381: }
                   13382: 
1.663     raeburn  13383: =pod
                   13384: 
                   13385: =item *&assign_categories_table()
                   13386: 
                   13387: Create a datatable for display of hierarchical categories in a domain,
                   13388: with checkboxes to allow a course to be categorized. 
                   13389: 
                   13390: Inputs:
                   13391: 
                   13392: cathash - reference to hash of categories defined for the domain (from
                   13393:           configuration.db)
                   13394: 
                   13395: currcat - scalar with an & separated list of categories assigned to a course. 
                   13396: 
1.919     raeburn  13397: type    - scalar contains course type (Course or Community).
                   13398: 
1.663     raeburn  13399: Returns: $output (markup to be displayed) 
                   13400: 
                   13401: =cut
                   13402: 
                   13403: sub assign_categories_table {
1.919     raeburn  13404:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13405:     my $output;
                   13406:     if (ref($cathash) eq 'HASH') {
                   13407:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13408:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13409:         $maxdepth = scalar(@cats);
                   13410:         if (@cats > 0) {
                   13411:             my $itemcount = 0;
                   13412:             if (ref($cats[0]) eq 'ARRAY') {
                   13413:                 my @currcategories;
                   13414:                 if ($currcat ne '') {
                   13415:                     @currcategories = split('&',$currcat);
                   13416:                 }
1.919     raeburn  13417:                 my $table;
1.663     raeburn  13418:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13419:                     my $parent = $cats[0][$i];
1.919     raeburn  13420:                     next if ($parent eq 'instcode');
                   13421:                     if ($type eq 'Community') {
                   13422:                         next unless ($parent eq 'communities');
                   13423:                     } else {
                   13424:                         next if ($parent eq 'communities');
                   13425:                     }
1.663     raeburn  13426:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13427:                     my $item = &escape($parent).'::0';
                   13428:                     my $checked = '';
                   13429:                     if (@currcategories > 0) {
                   13430:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13431:                             $checked = ' checked="checked"';
1.663     raeburn  13432:                         }
                   13433:                     }
1.919     raeburn  13434:                     my $parent_title = $parent;
                   13435:                     if ($parent eq 'communities') {
                   13436:                         $parent_title = &mt('Communities');
                   13437:                     }
                   13438:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13439:                               '<input type="checkbox" name="usecategory" value="'.
                   13440:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13441:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13442:                     my $depth = 1;
                   13443:                     push(@path,$parent);
1.919     raeburn  13444:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13445:                     pop(@path);
1.919     raeburn  13446:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13447:                     $itemcount ++;
                   13448:                 }
1.919     raeburn  13449:                 if ($itemcount) {
                   13450:                     $output = &Apache::loncommon::start_data_table().
                   13451:                               $table.
                   13452:                               &Apache::loncommon::end_data_table();
                   13453:                 }
1.663     raeburn  13454:             }
                   13455:         }
                   13456:     }
                   13457:     return $output;
                   13458: }
                   13459: 
                   13460: =pod
                   13461: 
                   13462: =item *&assign_category_rows()
                   13463: 
                   13464: Create a datatable row for display of nested categories in a domain,
                   13465: with checkboxes to allow a course to be categorized,called recursively.
                   13466: 
                   13467: Inputs:
                   13468: 
                   13469: itemcount - track row number for alternating colors
                   13470: 
                   13471: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13472:       categories and subcategories.
                   13473: 
                   13474: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13475: 
                   13476: parent - parent of current category item
                   13477: 
                   13478: path - Array containing all categories back up through the hierarchy from the
                   13479:        current category to the top level.
                   13480: 
                   13481: currcategories - reference to array of current categories assigned to the course
                   13482: 
                   13483: Returns: $output (markup to be displayed).
                   13484: 
                   13485: =cut
                   13486: 
                   13487: sub assign_category_rows {
                   13488:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13489:     my ($text,$name,$item,$chgstr);
                   13490:     if (ref($cats) eq 'ARRAY') {
                   13491:         my $maxdepth = scalar(@{$cats});
                   13492:         if (ref($cats->[$depth]) eq 'HASH') {
                   13493:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13494:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13495:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13496:                 $text .= '<td><table class="LC_datatable">';
                   13497:                 for (my $j=0; $j<$numchildren; $j++) {
                   13498:                     $name = $cats->[$depth]{$parent}[$j];
                   13499:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13500:                     my $deeper = $depth+1;
                   13501:                     my $checked = '';
                   13502:                     if (ref($currcategories) eq 'ARRAY') {
                   13503:                         if (@{$currcategories} > 0) {
                   13504:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13505:                                 $checked = ' checked="checked"';
1.663     raeburn  13506:                             }
                   13507:                         }
                   13508:                     }
1.664     raeburn  13509:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13510:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13511:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13512:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13513:                              '</td><td>';
1.663     raeburn  13514:                     if (ref($path) eq 'ARRAY') {
                   13515:                         push(@{$path},$name);
                   13516:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13517:                         pop(@{$path});
                   13518:                     }
                   13519:                     $text .= '</td></tr>';
                   13520:                 }
                   13521:                 $text .= '</table></td>';
                   13522:             }
                   13523:         }
                   13524:     }
                   13525:     return $text;
                   13526: }
                   13527: 
1.655     raeburn  13528: ############################################################
                   13529: ############################################################
                   13530: 
                   13531: 
1.443     albertel 13532: sub commit_customrole {
1.664     raeburn  13533:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13534:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13535:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13536:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13537:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13538:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13539:                  '</b><br />';
                   13540:     return $output;
                   13541: }
                   13542: 
                   13543: sub commit_standardrole {
1.1116    raeburn  13544:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  13545:     my ($output,$logmsg,$linefeed);
                   13546:     if ($context eq 'auto') {
                   13547:         $linefeed = "\n";
                   13548:     } else {
                   13549:         $linefeed = "<br />\n";
                   13550:     }  
1.443     albertel 13551:     if ($three eq 'st') {
1.541     raeburn  13552:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116    raeburn  13553:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  13554:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13555:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13556:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13557:         } else {
1.541     raeburn  13558:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13559:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13560:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13561:             if ($context eq 'auto') {
                   13562:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13563:             } else {
                   13564:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13565:                &mt('Add to classlist').': <b>ok</b>';
                   13566:             }
                   13567:             $output .= $linefeed;
1.443     albertel 13568:         }
                   13569:     } else {
                   13570:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13571:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13572:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13573:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13574:         if ($context eq 'auto') {
                   13575:             $output .= $result.$linefeed;
                   13576:         } else {
                   13577:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13578:         }
1.443     albertel 13579:     }
                   13580:     return $output;
                   13581: }
                   13582: 
                   13583: sub commit_studentrole {
1.1116    raeburn  13584:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   13585:         $credits) = @_;
1.626     raeburn  13586:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13587:     if ($context eq 'auto') {
                   13588:         $linefeed = "\n";
                   13589:     } else {
                   13590:         $linefeed = '<br />'."\n";
                   13591:     }
1.443     albertel 13592:     if (defined($one) && defined($two)) {
                   13593:         my $cid=$one.'_'.$two;
                   13594:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13595:         my $secchange = 0;
                   13596:         my $expire_role_result;
                   13597:         my $modify_section_result;
1.628     raeburn  13598:         if ($oldsec ne '-1') { 
                   13599:             if ($oldsec ne $sec) {
1.443     albertel 13600:                 $secchange = 1;
1.628     raeburn  13601:                 my $now = time;
1.443     albertel 13602:                 my $uurl='/'.$cid;
                   13603:                 $uurl=~s/\_/\//g;
                   13604:                 if ($oldsec) {
                   13605:                     $uurl.='/'.$oldsec;
                   13606:                 }
1.626     raeburn  13607:                 $oldsecurl = $uurl;
1.628     raeburn  13608:                 $expire_role_result = 
1.652     raeburn  13609:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13610:                 if ($env{'request.course.sec'} ne '') { 
                   13611:                     if ($expire_role_result eq 'refused') {
                   13612:                         my @roles = ('st');
                   13613:                         my @statuses = ('previous');
                   13614:                         my @roledoms = ($one);
                   13615:                         my $withsec = 1;
                   13616:                         my %roleshash = 
                   13617:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13618:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13619:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13620:                             my ($oldstart,$oldend) = 
                   13621:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13622:                             if ($oldend > 0 && $oldend <= $now) {
                   13623:                                 $expire_role_result = 'ok';
                   13624:                             }
                   13625:                         }
                   13626:                     }
                   13627:                 }
1.443     albertel 13628:                 $result = $expire_role_result;
                   13629:             }
                   13630:         }
                   13631:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116    raeburn  13632:             $modify_section_result = 
                   13633:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   13634:                                                            undef,undef,undef,$sec,
                   13635:                                                            $end,$start,'','',$cid,
                   13636:                                                            '',$context,$credits);
1.443     albertel 13637:             if ($modify_section_result =~ /^ok/) {
                   13638:                 if ($secchange == 1) {
1.628     raeburn  13639:                     if ($sec eq '') {
                   13640:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13641:                     } else {
                   13642:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13643:                     }
1.443     albertel 13644:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13645:                     if ($sec eq '') {
                   13646:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13647:                     } else {
                   13648:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13649:                     }
1.443     albertel 13650:                 } else {
1.628     raeburn  13651:                     if ($sec eq '') {
                   13652:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13653:                     } else {
                   13654:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13655:                     }
1.443     albertel 13656:                 }
                   13657:             } else {
1.1115    raeburn  13658:                 if ($secchange) { 
1.628     raeburn  13659:                     $$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;
                   13660:                 } else {
                   13661:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13662:                 }
1.443     albertel 13663:             }
                   13664:             $result = $modify_section_result;
                   13665:         } elsif ($secchange == 1) {
1.628     raeburn  13666:             if ($oldsec eq '') {
1.1103    raeburn  13667:                 $$logmsg .= &mt('Error when attempting to expire existing role without a section for [_1] in course [_2] -error: ',$uname,$cid).' '.$expire_role_result.$linefeed;
1.628     raeburn  13668:             } else {
                   13669:                 $$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;
                   13670:             }
1.626     raeburn  13671:             if ($expire_role_result eq 'refused') {
                   13672:                 my $newsecurl = '/'.$cid;
                   13673:                 $newsecurl =~ s/\_/\//g;
                   13674:                 if ($sec ne '') {
                   13675:                     $newsecurl.='/'.$sec;
                   13676:                 }
                   13677:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13678:                     if ($sec eq '') {
                   13679:                         $$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;
                   13680:                     } else {
                   13681:                         $$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;
                   13682:                     }
                   13683:                 }
                   13684:             }
1.443     albertel 13685:         }
                   13686:     } else {
1.626     raeburn  13687:         $$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 13688:         $result = "error: incomplete course id\n";
                   13689:     }
                   13690:     return $result;
                   13691: }
                   13692: 
1.1108    raeburn  13693: sub show_role_extent {
                   13694:     my ($scope,$context,$role) = @_;
                   13695:     $scope =~ s{^/}{};
                   13696:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   13697:     push(@courseroles,'co');
                   13698:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   13699:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   13700:         $scope =~ s{/}{_};
                   13701:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   13702:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   13703:         my ($audom,$auname) = split(/\//,$scope);
                   13704:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   13705:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   13706:     } else {
                   13707:         $scope =~ s{/$}{};
                   13708:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   13709:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   13710:     }
                   13711: }
                   13712: 
1.443     albertel 13713: ############################################################
                   13714: ############################################################
                   13715: 
1.566     albertel 13716: sub check_clone {
1.578     raeburn  13717:     my ($args,$linefeed) = @_;
1.566     albertel 13718:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13719:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13720:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13721:     my $clonemsg;
                   13722:     my $can_clone = 0;
1.944     raeburn  13723:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13724:     if ($lctype ne 'community') {
                   13725:         $lctype = 'course';
                   13726:     }
1.566     albertel 13727:     if ($clonehome eq 'no_host') {
1.944     raeburn  13728:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13729:             $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'});
                   13730:         } else {
                   13731:             $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'});
                   13732:         }     
1.566     albertel 13733:     } else {
                   13734: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13735:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13736:             if ($clonedesc{'type'} ne 'Community') {
                   13737:                  $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'});
                   13738:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13739:             }
                   13740:         }
1.882     raeburn  13741: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13742:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13743: 	    $can_clone = 1;
                   13744: 	} else {
                   13745: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13746: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13747: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13748:             if (grep(/^\*$/,@cloners)) {
                   13749:                 $can_clone = 1;
                   13750:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13751:                 $can_clone = 1;
                   13752:             } else {
1.908     raeburn  13753:                 my $ccrole = 'cc';
1.944     raeburn  13754:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13755:                     $ccrole = 'co';
                   13756:                 }
1.578     raeburn  13757: 	        my %roleshash =
                   13758: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13759: 					 $args->{'ccdomain'},
1.908     raeburn  13760:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13761: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13762: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13763:                     $can_clone = 1;
                   13764:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13765:                     $can_clone = 1;
                   13766:                 } else {
1.944     raeburn  13767:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13768:                         $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'});
                   13769:                     } else {
                   13770:                         $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'});
                   13771:                     }
1.578     raeburn  13772: 	        }
1.566     albertel 13773: 	    }
1.578     raeburn  13774:         }
1.566     albertel 13775:     }
                   13776:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13777: }
                   13778: 
1.444     albertel 13779: sub construct_course {
1.885     raeburn  13780:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 13781:     my $outcome;
1.541     raeburn  13782:     my $linefeed =  '<br />'."\n";
                   13783:     if ($context eq 'auto') {
                   13784:         $linefeed = "\n";
                   13785:     }
1.566     albertel 13786: 
                   13787: #
                   13788: # Are we cloning?
                   13789: #
                   13790:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13791:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13792: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13793: 	if ($context ne 'auto') {
1.578     raeburn  13794:             if ($clonemsg ne '') {
                   13795: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13796:             }
1.566     albertel 13797: 	}
                   13798: 	$outcome .= $clonemsg.$linefeed;
                   13799: 
                   13800:         if (!$can_clone) {
                   13801: 	    return (0,$outcome);
                   13802: 	}
                   13803:     }
                   13804: 
1.444     albertel 13805: #
                   13806: # Open course
                   13807: #
                   13808:     my $crstype = lc($args->{'crstype'});
                   13809:     my %cenv=();
                   13810:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13811:                                              $args->{'cdescr'},
                   13812:                                              $args->{'curl'},
                   13813:                                              $args->{'course_home'},
                   13814:                                              $args->{'nonstandard'},
                   13815:                                              $args->{'crscode'},
                   13816:                                              $args->{'ccuname'}.':'.
                   13817:                                              $args->{'ccdomain'},
1.882     raeburn  13818:                                              $args->{'crstype'},
1.885     raeburn  13819:                                              $cnum,$context,$category);
1.444     albertel 13820: 
                   13821:     # Note: The testing routines depend on this being output; see 
                   13822:     # Utils::Course. This needs to at least be output as a comment
                   13823:     # if anyone ever decides to not show this, and Utils::Course::new
                   13824:     # will need to be suitably modified.
1.541     raeburn  13825:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13826:     if ($$courseid =~ /^error:/) {
                   13827:         return (0,$outcome);
                   13828:     }
                   13829: 
1.444     albertel 13830: #
                   13831: # Check if created correctly
                   13832: #
1.479     albertel 13833:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13834:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13835:     if ($crsuhome eq 'no_host') {
                   13836:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13837:         return (0,$outcome);
                   13838:     }
1.541     raeburn  13839:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13840: 
1.444     albertel 13841: #
1.566     albertel 13842: # Do the cloning
                   13843: #   
                   13844:     if ($can_clone && $cloneid) {
                   13845: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13846: 	if ($context ne 'auto') {
                   13847: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13848: 	}
                   13849: 	$outcome .= $clonemsg.$linefeed;
                   13850: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13851: # Copy all files
1.637     www      13852: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 13853: # Restore URL
1.566     albertel 13854: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 13855: # Restore title
1.566     albertel 13856: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  13857: # Restore creation date, creator and creation context.
                   13858:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   13859:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   13860:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 13861: # Mark as cloned
1.566     albertel 13862: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      13863: # Need to clone grading mode
                   13864:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   13865:         $cenv{'grading'}=$newenv{'grading'};
                   13866: # Do not clone these environment entries
                   13867:         &Apache::lonnet::del('environment',
                   13868:                   ['default_enrollment_start_date',
                   13869:                    'default_enrollment_end_date',
                   13870:                    'question.email',
                   13871:                    'policy.email',
                   13872:                    'comment.email',
                   13873:                    'pch.users.denied',
1.725     raeburn  13874:                    'plc.users.denied',
                   13875:                    'hidefromcat',
1.1121    raeburn  13876:                    'checkforpriv',
1.725     raeburn  13877:                    'categories'],
1.638     www      13878:                    $$crsudom,$$crsunum);
1.444     albertel 13879:     }
1.566     albertel 13880: 
1.444     albertel 13881: #
                   13882: # Set environment (will override cloned, if existing)
                   13883: #
                   13884:     my @sections = ();
                   13885:     my @xlists = ();
                   13886:     if ($args->{'crstype'}) {
                   13887:         $cenv{'type'}=$args->{'crstype'};
                   13888:     }
                   13889:     if ($args->{'crsid'}) {
                   13890:         $cenv{'courseid'}=$args->{'crsid'};
                   13891:     }
                   13892:     if ($args->{'crscode'}) {
                   13893:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   13894:     }
                   13895:     if ($args->{'crsquota'} ne '') {
                   13896:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   13897:     } else {
                   13898:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   13899:     }
                   13900:     if ($args->{'ccuname'}) {
                   13901:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   13902:                                         ':'.$args->{'ccdomain'};
                   13903:     } else {
                   13904:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   13905:     }
1.1116    raeburn  13906:     if ($args->{'defaultcredits'}) {
                   13907:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   13908:     }
1.444     albertel 13909:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   13910:     if ($args->{'crssections'}) {
                   13911:         $cenv{'internal.sectionnums'} = '';
                   13912:         if ($args->{'crssections'} =~ m/,/) {
                   13913:             @sections = split/,/,$args->{'crssections'};
                   13914:         } else {
                   13915:             $sections[0] = $args->{'crssections'};
                   13916:         }
                   13917:         if (@sections > 0) {
                   13918:             foreach my $item (@sections) {
                   13919:                 my ($sec,$gp) = split/:/,$item;
                   13920:                 my $class = $args->{'crscode'}.$sec;
                   13921:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   13922:                 $cenv{'internal.sectionnums'} .= $item.',';
                   13923:                 unless ($addcheck eq 'ok') {
                   13924:                     push @badclasses, $class;
                   13925:                 }
                   13926:             }
                   13927:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   13928:         }
                   13929:     }
                   13930: # do not hide course coordinator from staff listing, 
                   13931: # even if privileged
                   13932:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121    raeburn  13933: # add course coordinator's domain to domains to check for privileged users
                   13934: # if different to course domain
                   13935:     if ($$crsudom ne $args->{'ccdomain'}) {
                   13936:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   13937:     }
1.444     albertel 13938: # add crosslistings
                   13939:     if ($args->{'crsxlist'}) {
                   13940:         $cenv{'internal.crosslistings'}='';
                   13941:         if ($args->{'crsxlist'} =~ m/,/) {
                   13942:             @xlists = split/,/,$args->{'crsxlist'};
                   13943:         } else {
                   13944:             $xlists[0] = $args->{'crsxlist'};
                   13945:         }
                   13946:         if (@xlists > 0) {
                   13947:             foreach my $item (@xlists) {
                   13948:                 my ($xl,$gp) = split/:/,$item;
                   13949:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   13950:                 $cenv{'internal.crosslistings'} .= $item.',';
                   13951:                 unless ($addcheck eq 'ok') {
                   13952:                     push @badclasses, $xl;
                   13953:                 }
                   13954:             }
                   13955:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   13956:         }
                   13957:     }
                   13958:     if ($args->{'autoadds'}) {
                   13959:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   13960:     }
                   13961:     if ($args->{'autodrops'}) {
                   13962:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   13963:     }
                   13964: # check for notification of enrollment changes
                   13965:     my @notified = ();
                   13966:     if ($args->{'notify_owner'}) {
                   13967:         if ($args->{'ccuname'} ne '') {
                   13968:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   13969:         }
                   13970:     }
                   13971:     if ($args->{'notify_dc'}) {
                   13972:         if ($uname ne '') { 
1.630     raeburn  13973:             push(@notified,$uname.':'.$udom);
1.444     albertel 13974:         }
                   13975:     }
                   13976:     if (@notified > 0) {
                   13977:         my $notifylist;
                   13978:         if (@notified > 1) {
                   13979:             $notifylist = join(',',@notified);
                   13980:         } else {
                   13981:             $notifylist = $notified[0];
                   13982:         }
                   13983:         $cenv{'internal.notifylist'} = $notifylist;
                   13984:     }
                   13985:     if (@badclasses > 0) {
                   13986:         my %lt=&Apache::lonlocal::texthash(
                   13987:                 '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',
                   13988:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   13989:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   13990:         );
1.541     raeburn  13991:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   13992:                            ' ('.$lt{'adby'}.')';
                   13993:         if ($context eq 'auto') {
                   13994:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 13995:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  13996:             foreach my $item (@badclasses) {
                   13997:                 if ($context eq 'auto') {
                   13998:                     $outcome .= " - $item\n";
                   13999:                 } else {
                   14000:                     $outcome .= "<li>$item</li>\n";
                   14001:                 }
                   14002:             }
                   14003:             if ($context eq 'auto') {
                   14004:                 $outcome .= $linefeed;
                   14005:             } else {
1.566     albertel 14006:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14007:             }
                   14008:         } 
1.444     albertel 14009:     }
                   14010:     if ($args->{'no_end_date'}) {
                   14011:         $args->{'endaccess'} = 0;
                   14012:     }
                   14013:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14014:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14015:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14016:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14017:     if ($args->{'showphotos'}) {
                   14018:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14019:     }
                   14020:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14021:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14022:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14023:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14024:             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'); 
                   14025:             if ($context eq 'auto') {
                   14026:                 $outcome .= $krb_msg;
                   14027:             } else {
1.566     albertel 14028:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14029:             }
                   14030:             $outcome .= $linefeed;
1.444     albertel 14031:         }
                   14032:     }
                   14033:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14034:        if ($args->{'setpolicy'}) {
                   14035:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14036:        }
                   14037:        if ($args->{'setcontent'}) {
                   14038:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14039:        }
                   14040:     }
                   14041:     if ($args->{'reshome'}) {
                   14042: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14043: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14044:     }
                   14045: #
                   14046: # course has keyed access
                   14047: #
                   14048:     if ($args->{'setkeys'}) {
                   14049:        $cenv{'keyaccess'}='yes';
                   14050:     }
                   14051: # if specified, key authority is not course, but user
                   14052: # only active if keyaccess is yes
                   14053:     if ($args->{'keyauth'}) {
1.487     albertel 14054: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14055: 	$user = &LONCAPA::clean_username($user);
                   14056: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14057: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14058: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14059: 	}
                   14060:     }
                   14061: 
                   14062:     if ($args->{'disresdis'}) {
                   14063:         $cenv{'pch.roles.denied'}='st';
                   14064:     }
                   14065:     if ($args->{'disablechat'}) {
                   14066:         $cenv{'plc.roles.denied'}='st';
                   14067:     }
                   14068: 
                   14069:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14070:     # course
                   14071:     $cenv{'course.helper.not.run'} = 1;
                   14072:     #
                   14073:     # Use new Randomseed
                   14074:     #
                   14075:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14076:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14077:     #
                   14078:     # The encryption code and receipt prefix for this course
                   14079:     #
                   14080:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14081:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14082:     #
                   14083:     # By default, use standard grading
                   14084:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14085: 
1.541     raeburn  14086:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14087:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14088: #
                   14089: # Open all assignments
                   14090: #
                   14091:     if ($args->{'openall'}) {
                   14092:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14093:        my %storecontent = ($storeunder         => time,
                   14094:                            $storeunder.'.type' => 'date_start');
                   14095:        
                   14096:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14097:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14098:    }
                   14099: #
                   14100: # Set first page
                   14101: #
                   14102:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14103: 	    || ($cloneid)) {
1.445     albertel 14104: 	use LONCAPA::map;
1.444     albertel 14105: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14106: 
                   14107: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14108:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14109: 
1.444     albertel 14110:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14111:         my $title; my $url;
                   14112:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14113: 	    $title=&mt('Syllabus');
1.444     albertel 14114:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14115:         } else {
1.963     raeburn  14116:             $title=&mt('Table of Contents');
1.444     albertel 14117:             $url='/adm/navmaps';
                   14118:         }
1.445     albertel 14119: 
                   14120:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14121: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14122: 
                   14123: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14124:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14125:     }
1.566     albertel 14126: 
                   14127:     return (1,$outcome);
1.444     albertel 14128: }
                   14129: 
                   14130: ############################################################
                   14131: ############################################################
                   14132: 
1.953     droeschl 14133: #SD
                   14134: # only Community and Course, or anything else?
1.378     raeburn  14135: sub course_type {
                   14136:     my ($cid) = @_;
                   14137:     if (!defined($cid)) {
                   14138:         $cid = $env{'request.course.id'};
                   14139:     }
1.404     albertel 14140:     if (defined($env{'course.'.$cid.'.type'})) {
                   14141:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  14142:     } else {
                   14143:         return 'Course';
1.377     raeburn  14144:     }
                   14145: }
1.156     albertel 14146: 
1.406     raeburn  14147: sub group_term {
                   14148:     my $crstype = &course_type();
                   14149:     my %names = (
                   14150:                   'Course' => 'group',
1.865     raeburn  14151:                   'Community' => 'group',
1.406     raeburn  14152:                 );
                   14153:     return $names{$crstype};
                   14154: }
                   14155: 
1.902     raeburn  14156: sub course_types {
                   14157:     my @types = ('official','unofficial','community');
                   14158:     my %typename = (
                   14159:                          official   => 'Official course',
                   14160:                          unofficial => 'Unofficial course',
                   14161:                          community  => 'Community',
                   14162:                    );
                   14163:     return (\@types,\%typename);
                   14164: }
                   14165: 
1.156     albertel 14166: sub icon {
                   14167:     my ($file)=@_;
1.505     albertel 14168:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 14169:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 14170:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 14171:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   14172: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   14173: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14174: 	            $curfext.".gif") {
                   14175: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14176: 		$curfext.".gif";
                   14177: 	}
                   14178:     }
1.249     albertel 14179:     return &lonhttpdurl($iconname);
1.154     albertel 14180: } 
1.84      albertel 14181: 
1.575     albertel 14182: sub lonhttpdurl {
1.692     www      14183: #
                   14184: # Had been used for "small fry" static images on separate port 8080.
                   14185: # Modify here if lightweight http functionality desired again.
                   14186: # Currently eliminated due to increasing firewall issues.
                   14187: #
1.575     albertel 14188:     my ($url)=@_;
1.692     www      14189:     return $url;
1.215     albertel 14190: }
                   14191: 
1.213     albertel 14192: sub connection_aborted {
                   14193:     my ($r)=@_;
                   14194:     $r->print(" ");$r->rflush();
                   14195:     my $c = $r->connection;
                   14196:     return $c->aborted();
                   14197: }
                   14198: 
1.221     foxr     14199: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     14200: #    strings as 'strings'.
                   14201: sub escape_single {
1.221     foxr     14202:     my ($input) = @_;
1.223     albertel 14203:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     14204:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   14205:     return $input;
                   14206: }
1.223     albertel 14207: 
1.222     foxr     14208: #  Same as escape_single, but escape's "'s  This 
                   14209: #  can be used for  "strings"
                   14210: sub escape_double {
                   14211:     my ($input) = @_;
                   14212:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   14213:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   14214:     return $input;
                   14215: }
1.223     albertel 14216:  
1.222     foxr     14217: #   Escapes the last element of a full URL.
                   14218: sub escape_url {
                   14219:     my ($url)   = @_;
1.238     raeburn  14220:     my @urlslices = split(/\//, $url,-1);
1.369     www      14221:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 14222:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     14223: }
1.462     albertel 14224: 
1.820     raeburn  14225: sub compare_arrays {
                   14226:     my ($arrayref1,$arrayref2) = @_;
                   14227:     my (@difference,%count);
                   14228:     @difference = ();
                   14229:     %count = ();
                   14230:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   14231:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   14232:         foreach my $element (keys(%count)) {
                   14233:             if ($count{$element} == 1) {
                   14234:                 push(@difference,$element);
                   14235:             }
                   14236:         }
                   14237:     }
                   14238:     return @difference;
                   14239: }
                   14240: 
1.817     bisitz   14241: # -------------------------------------------------------- Initialize user login
1.462     albertel 14242: sub init_user_environment {
1.463     albertel 14243:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 14244:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   14245: 
                   14246:     my $public=($username eq 'public' && $domain eq 'public');
                   14247: 
                   14248: # See if old ID present, if so, remove
                   14249: 
1.1062    raeburn  14250:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 14251:     my $now=time;
                   14252: 
                   14253:     if ($public) {
                   14254: 	my $max_public=100;
                   14255: 	my $oldest;
                   14256: 	my $oldest_time=0;
                   14257: 	for(my $next=1;$next<=$max_public;$next++) {
                   14258: 	    if (-e $lonids."/publicuser_$next.id") {
                   14259: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   14260: 		if ($mtime<$oldest_time || !$oldest_time) {
                   14261: 		    $oldest_time=$mtime;
                   14262: 		    $oldest=$next;
                   14263: 		}
                   14264: 	    } else {
                   14265: 		$cookie="publicuser_$next";
                   14266: 		last;
                   14267: 	    }
                   14268: 	}
                   14269: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   14270:     } else {
1.463     albertel 14271: 	# if this isn't a robot, kill any existing non-robot sessions
                   14272: 	if (!$args->{'robot'}) {
                   14273: 	    opendir(DIR,$lonids);
                   14274: 	    while ($filename=readdir(DIR)) {
                   14275: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   14276: 		    unlink($lonids.'/'.$filename);
                   14277: 		}
1.462     albertel 14278: 	    }
1.463     albertel 14279: 	    closedir(DIR);
1.462     albertel 14280: 	}
                   14281: # Give them a new cookie
1.463     albertel 14282: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      14283: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 14284: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 14285:     
                   14286: # Initialize roles
                   14287: 
1.1062    raeburn  14288: 	($userroles,$firstaccenv,$timerintenv) = 
                   14289:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 14290:     }
                   14291: # ------------------------------------ Check browser type and MathML capability
                   14292: 
                   14293:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1141    raeburn  14294:         $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
1.462     albertel 14295: 
                   14296: # ------------------------------------------------------------- Get environment
                   14297: 
                   14298:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   14299:     my ($tmp) = keys(%userenv);
                   14300:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   14301:     } else {
                   14302: 	undef(%userenv);
                   14303:     }
                   14304:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   14305: 	$form->{'interface'}=$userenv{'interface'};
                   14306:     }
                   14307:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   14308: 
                   14309: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   14310:     foreach my $option ('interface','localpath','localres') {
                   14311:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 14312:     }
                   14313: # --------------------------------------------------------- Write first profile
                   14314: 
                   14315:     {
                   14316: 	my %initial_env = 
                   14317: 	    ("user.name"          => $username,
                   14318: 	     "user.domain"        => $domain,
                   14319: 	     "user.home"          => $authhost,
                   14320: 	     "browser.type"       => $clientbrowser,
                   14321: 	     "browser.version"    => $clientversion,
                   14322: 	     "browser.mathml"     => $clientmathml,
                   14323: 	     "browser.unicode"    => $clientunicode,
                   14324: 	     "browser.os"         => $clientos,
1.1137    raeburn  14325:              "browser.mobile"     => $clientmobile,
1.1141    raeburn  14326:              "browser.info"       => $clientinfo,
1.462     albertel 14327: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   14328: 	     "request.course.fn"  => '',
                   14329: 	     "request.course.uri" => '',
                   14330: 	     "request.course.sec" => '',
                   14331: 	     "request.role"       => 'cm',
                   14332: 	     "request.role.adv"   => $env{'user.adv'},
                   14333: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   14334: 
                   14335:         if ($form->{'localpath'}) {
                   14336: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   14337: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   14338:         }
                   14339: 	
                   14340: 	if ($form->{'interface'}) {
                   14341: 	    $form->{'interface'}=~s/\W//gs;
                   14342: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   14343: 	    $env{'browser.interface'}=$form->{'interface'};
                   14344: 	}
                   14345: 
1.981     raeburn  14346:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  14347:         my %domdef;
                   14348:         unless ($domain eq 'public') {
                   14349:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   14350:         }
1.980     raeburn  14351: 
1.1081    raeburn  14352:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  14353:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  14354:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   14355:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  14356:         }
                   14357: 
1.864     raeburn  14358:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  14359:             $userenv{'canrequest.'.$crstype} =
                   14360:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  14361:                                                   'reload','requestcourses',
                   14362:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  14363:         }
                   14364: 
1.1092    raeburn  14365:         $userenv{'canrequest.author'} =
                   14366:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   14367:                                         'reload','requestauthor',
                   14368:                                         \%userenv,\%domdef,\%is_adv);
                   14369:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   14370:                                              $domain,$username);
                   14371:         my $reqstatus = $reqauthor{'author_status'};
                   14372:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   14373:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   14374:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   14375:                                                   $reqauthor{'author'}{'timestamp'};
                   14376:             }
                   14377:         }
                   14378: 
1.462     albertel 14379: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  14380: 
1.462     albertel 14381: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   14382: 		 &GDBM_WRCREAT(),0640)) {
                   14383: 	    &_add_to_env(\%disk_env,\%initial_env);
                   14384: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   14385: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  14386:             if (ref($firstaccenv) eq 'HASH') {
                   14387:                 &_add_to_env(\%disk_env,$firstaccenv);
                   14388:             }
                   14389:             if (ref($timerintenv) eq 'HASH') {
                   14390:                 &_add_to_env(\%disk_env,$timerintenv);
                   14391:             }
1.463     albertel 14392: 	    if (ref($args->{'extra_env'})) {
                   14393: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   14394: 	    }
1.462     albertel 14395: 	    untie(%disk_env);
                   14396: 	} else {
1.705     tempelho 14397: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   14398: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 14399: 	    return 'error: '.$!;
                   14400: 	}
                   14401:     }
                   14402:     $env{'request.role'}='cm';
                   14403:     $env{'request.role.adv'}=$env{'user.adv'};
                   14404:     $env{'browser.type'}=$clientbrowser;
                   14405: 
                   14406:     return $cookie;
                   14407: 
                   14408: }
                   14409: 
                   14410: sub _add_to_env {
                   14411:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14412:     if (ref($env_data) eq 'HASH') {
                   14413:         while (my ($key,$value) = each(%$env_data)) {
                   14414: 	    $idf->{$prefix.$key} = $value;
                   14415: 	    $env{$prefix.$key}   = $value;
                   14416:         }
1.462     albertel 14417:     }
                   14418: }
                   14419: 
1.685     tempelho 14420: # --- Get the symbolic name of a problem and the url
                   14421: sub get_symb {
                   14422:     my ($request,$silent) = @_;
1.726     raeburn  14423:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14424:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14425:     if ($symb eq '') {
                   14426:         if (!$silent) {
1.1071    raeburn  14427:             if (ref($request)) { 
                   14428:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14429:             }
1.685     tempelho 14430:             return ();
                   14431:         }
                   14432:     }
                   14433:     &Apache::lonenc::check_decrypt(\$symb);
                   14434:     return ($symb);
                   14435: }
                   14436: 
                   14437: # --------------------------------------------------------------Get annotation
                   14438: 
                   14439: sub get_annotation {
                   14440:     my ($symb,$enc) = @_;
                   14441: 
                   14442:     my $key = $symb;
                   14443:     if (!$enc) {
                   14444:         $key =
                   14445:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14446:     }
                   14447:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14448:     return $annotation{$key};
                   14449: }
                   14450: 
                   14451: sub clean_symb {
1.731     raeburn  14452:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14453: 
                   14454:     &Apache::lonenc::check_decrypt(\$symb);
                   14455:     my $enc = $env{'request.enc'};
1.731     raeburn  14456:     if ($delete_enc) {
1.730     raeburn  14457:         delete($env{'request.enc'});
                   14458:     }
1.685     tempelho 14459: 
                   14460:     return ($symb,$enc);
                   14461: }
1.462     albertel 14462: 
1.990     raeburn  14463: sub build_release_hashes {
                   14464:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   14465:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   14466:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   14467:                   (ref($randomizetry) eq 'HASH'));
                   14468:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14469:         my ($item,$name,$value) = split(/:/,$key);
                   14470:         if ($item eq 'parameter') {
                   14471:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   14472:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   14473:                     push(@{$checkparms->{$name}},$value);
                   14474:                 }
                   14475:             } else {
                   14476:                 push(@{$checkparms->{$name}},$value);
                   14477:             }
                   14478:         } elsif ($item eq 'resourcetag') {
                   14479:             if ($name eq 'responsetype') {
                   14480:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   14481:             }
                   14482:         } elsif ($item eq 'course') {
                   14483:             if ($name eq 'crstype') {
                   14484:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   14485:             }
                   14486:         }
                   14487:     }
                   14488:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   14489:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   14490:     return;
                   14491: }
                   14492: 
1.1083    raeburn  14493: sub update_content_constraints {
                   14494:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14495:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   14496:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   14497:     my %checkresponsetypes;
                   14498:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14499:         my ($item,$name,$value) = split(/:/,$key);
                   14500:         if ($item eq 'resourcetag') {
                   14501:             if ($name eq 'responsetype') {
                   14502:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   14503:             }
                   14504:         }
                   14505:     }
                   14506:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14507:     if (defined($navmap)) {
                   14508:         my %allresponses;
                   14509:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   14510:             my %responses = $res->responseTypes();
                   14511:             foreach my $key (keys(%responses)) {
                   14512:                 next unless(exists($checkresponsetypes{$key}));
                   14513:                 $allresponses{$key} += $responses{$key};
                   14514:             }
                   14515:         }
                   14516:         foreach my $key (keys(%allresponses)) {
                   14517:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   14518:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   14519:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   14520:             }
                   14521:         }
                   14522:         undef($navmap);
                   14523:     }
                   14524:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   14525:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   14526:     }
                   14527:     return;
                   14528: }
                   14529: 
1.1110    raeburn  14530: sub allmaps_incourse {
                   14531:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14532:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   14533:         $cid = $env{'request.course.id'};
                   14534:         $cdom = $env{'course.'.$cid.'.domain'};
                   14535:         $cnum = $env{'course.'.$cid.'.num'};
                   14536:         $chome = $env{'course.'.$cid.'.home'};
                   14537:     }
                   14538:     my %allmaps = ();
                   14539:     my $lastchange =
                   14540:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   14541:     if ($lastchange > $env{'request.course.tied'}) {
                   14542:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   14543:         unless ($ferr) {
                   14544:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   14545:         }
                   14546:     }
                   14547:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14548:     if (defined($navmap)) {
                   14549:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   14550:             $allmaps{$res->src()} = 1;
                   14551:         }
                   14552:     }
                   14553:     return \%allmaps;
                   14554: }
                   14555: 
1.1083    raeburn  14556: sub parse_supplemental_title {
                   14557:     my ($title) = @_;
                   14558: 
                   14559:     my ($foldertitle,$renametitle);
                   14560:     if ($title =~ /&amp;&amp;&amp;/) {
                   14561:         $title = &HTML::Entites::decode($title);
                   14562:     }
                   14563:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   14564:         $renametitle=$4;
                   14565:         my ($time,$uname,$udom) = ($1,$2,$3);
                   14566:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   14567:         my $name =  &plainname($uname,$udom);
                   14568:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   14569:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   14570:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   14571:             $name.': <br />'.$foldertitle;
                   14572:     }
                   14573:     if (wantarray) {
                   14574:         return ($title,$foldertitle,$renametitle);
                   14575:     }
                   14576:     return $title;
                   14577: }
                   14578: 
1.1143  ! raeburn  14579: sub recurse_supplemental {
        !          14580:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
        !          14581:     if ($suppmap) {
        !          14582:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
        !          14583:         if ($fatal) {
        !          14584:             $errors ++;
        !          14585:         } else {
        !          14586:             if ($#LONCAPA::map::resources > 0) {
        !          14587:                 foreach my $res (@LONCAPA::map::resources) {
        !          14588:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
        !          14589:                     if (($src ne '') && ($status eq 'res')) {
        !          14590:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_/d+\.sequence)$}) {
        !          14591:                             $numfiles = &recurse_supplemental($cnum,$cdom,$1,$numfiles);
        !          14592:                         } else {
        !          14593:                             $numfiles ++;
        !          14594:                         }
        !          14595:                     }
        !          14596:                 }
        !          14597:             }
        !          14598:         }
        !          14599:     }
        !          14600:     return ($numfiles,$errors);
        !          14601: }
        !          14602: 
1.1101    raeburn  14603: sub symb_to_docspath {
                   14604:     my ($symb) = @_;
                   14605:     return unless ($symb);
                   14606:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   14607:     if ($resurl=~/\.(sequence|page)$/) {
                   14608:         $mapurl=$resurl;
                   14609:     } elsif ($resurl eq 'adm/navmaps') {
                   14610:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   14611:     }
                   14612:     my $mapresobj;
                   14613:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14614:     if (ref($navmap)) {
                   14615:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   14616:     }
                   14617:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   14618:     my $type=$2;
                   14619:     my $path;
                   14620:     if (ref($mapresobj)) {
                   14621:         my $pcslist = $mapresobj->map_hierarchy();
                   14622:         if ($pcslist ne '') {
                   14623:             foreach my $pc (split(/,/,$pcslist)) {
                   14624:                 next if ($pc <= 1);
                   14625:                 my $res = $navmap->getByMapPc($pc);
                   14626:                 if (ref($res)) {
                   14627:                     my $thisurl = $res->src();
                   14628:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   14629:                     my $thistitle = $res->title();
                   14630:                     $path .= '&'.
                   14631:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
                   14632:                              &Apache::lonhtmlcommon::entity_encode($thistitle).
                   14633:                              ':'.$res->randompick().
                   14634:                              ':'.$res->randomout().
                   14635:                              ':'.$res->encrypted().
                   14636:                              ':'.$res->randomorder().
                   14637:                              ':'.$res->is_page();
                   14638:                 }
                   14639:             }
                   14640:         }
                   14641:         $path =~ s/^\&//;
                   14642:         my $maptitle = $mapresobj->title();
                   14643:         if ($mapurl eq 'default') {
1.1129    raeburn  14644:             $maptitle = 'Main Content';
1.1101    raeburn  14645:         }
                   14646:         $path .= (($path ne '')? '&' : '').
                   14647:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
                   14648:                  &Apache::lonhtmlcommon::entity_encode($maptitle).
                   14649:                  ':'.$mapresobj->randompick().
                   14650:                  ':'.$mapresobj->randomout().
                   14651:                  ':'.$mapresobj->encrypted().
                   14652:                  ':'.$mapresobj->randomorder().
                   14653:                  ':'.$mapresobj->is_page();
                   14654:     } else {
                   14655:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   14656:         my $ispage = (($type eq 'page')? 1 : '');
                   14657:         if ($mapurl eq 'default') {
1.1129    raeburn  14658:             $maptitle = 'Main Content';
1.1101    raeburn  14659:         }
                   14660:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
                   14661:                 &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage;
                   14662:     }
                   14663:     unless ($mapurl eq 'default') {
                   14664:         $path = 'default&'.
1.1129    raeburn  14665:                 &Apache::lonhtmlcommon::entity_encode('Main Content').
1.1101    raeburn  14666:                 ':::::&'.$path;
                   14667:     }
                   14668:     return $path;
                   14669: }
                   14670: 
1.1094    raeburn  14671: sub captcha_display {
                   14672:     my ($context,$lonhost) = @_;
                   14673:     my ($output,$error);
                   14674:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  14675:     if ($captcha eq 'original') {
1.1094    raeburn  14676:         $output = &create_captcha();
                   14677:         unless ($output) {
                   14678:             $error = 'captcha'; 
                   14679:         }
                   14680:     } elsif ($captcha eq 'recaptcha') {
                   14681:         $output = &create_recaptcha($pubkey);
                   14682:         unless ($output) {
1.1095    raeburn  14683:             $error = 'recaptcha'; 
1.1094    raeburn  14684:         }
                   14685:     }
                   14686:     return ($output,$error);
                   14687: }
                   14688: 
                   14689: sub captcha_response {
                   14690:     my ($context,$lonhost) = @_;
                   14691:     my ($captcha_chk,$captcha_error);
                   14692:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  14693:     if ($captcha eq 'original') {
1.1094    raeburn  14694:         ($captcha_chk,$captcha_error) = &check_captcha();
                   14695:     } elsif ($captcha eq 'recaptcha') {
                   14696:         $captcha_chk = &check_recaptcha($privkey);
                   14697:     } else {
                   14698:         $captcha_chk = 1;
                   14699:     }
                   14700:     return ($captcha_chk,$captcha_error);
                   14701: }
                   14702: 
                   14703: sub get_captcha_config {
                   14704:     my ($context,$lonhost) = @_;
1.1095    raeburn  14705:     my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094    raeburn  14706:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   14707:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   14708:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095    raeburn  14709:     if ($context eq 'usercreation') {
                   14710:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   14711:         if (ref($domconfig{$context}) eq 'HASH') {
                   14712:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   14713:             if (ref($hashtocheck) eq 'HASH') {
                   14714:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   14715:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   14716:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   14717:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   14718:                     }
                   14719:                     if ($privkey && $pubkey) {
                   14720:                         $captcha = 'recaptcha';
                   14721:                     } else {
                   14722:                         $captcha = 'original';
                   14723:                     }
                   14724:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   14725:                     $captcha = 'original';
                   14726:                 }
1.1094    raeburn  14727:             }
1.1095    raeburn  14728:         } else {
                   14729:             $captcha = 'captcha';
                   14730:         }
                   14731:     } elsif ($context eq 'login') {
                   14732:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   14733:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   14734:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   14735:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094    raeburn  14736:             if ($privkey && $pubkey) {
                   14737:                 $captcha = 'recaptcha';
1.1095    raeburn  14738:             } else {
                   14739:                 $captcha = 'original';
1.1094    raeburn  14740:             }
1.1095    raeburn  14741:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   14742:             $captcha = 'original';
1.1094    raeburn  14743:         }
                   14744:     }
                   14745:     return ($captcha,$pubkey,$privkey);
                   14746: }
                   14747: 
                   14748: sub create_captcha {
                   14749:     my %captcha_params = &captcha_settings();
                   14750:     my ($output,$maxtries,$tries) = ('',10,0);
                   14751:     while ($tries < $maxtries) {
                   14752:         $tries ++;
                   14753:         my $captcha = Authen::Captcha->new (
                   14754:                                            output_folder => $captcha_params{'output_dir'},
                   14755:                                            data_folder   => $captcha_params{'db_dir'},
                   14756:                                           );
                   14757:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   14758: 
                   14759:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   14760:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   14761:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
                   14762:                      '<input type="text" size="5" name="code" value="" /><br />'.
                   14763:                      '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
                   14764:             last;
                   14765:         }
                   14766:     }
                   14767:     return $output;
                   14768: }
                   14769: 
                   14770: sub captcha_settings {
                   14771:     my %captcha_params = (
                   14772:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   14773:                            www_output_dir => "/captchaspool",
                   14774:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   14775:                            numchars       => '5',
                   14776:                          );
                   14777:     return %captcha_params;
                   14778: }
                   14779: 
                   14780: sub check_captcha {
                   14781:     my ($captcha_chk,$captcha_error);
                   14782:     my $code = $env{'form.code'};
                   14783:     my $md5sum = $env{'form.crypt'};
                   14784:     my %captcha_params = &captcha_settings();
                   14785:     my $captcha = Authen::Captcha->new(
                   14786:                       output_folder => $captcha_params{'output_dir'},
                   14787:                       data_folder   => $captcha_params{'db_dir'},
                   14788:                   );
1.1109    raeburn  14789:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094    raeburn  14790:     my %captcha_hash = (
                   14791:                         0       => 'Code not checked (file error)',
                   14792:                        -1      => 'Failed: code expired',
                   14793:                        -2      => 'Failed: invalid code (not in database)',
                   14794:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   14795:     );
                   14796:     if ($captcha_chk != 1) {
                   14797:         $captcha_error = $captcha_hash{$captcha_chk}
                   14798:     }
                   14799:     return ($captcha_chk,$captcha_error);
                   14800: }
                   14801: 
                   14802: sub create_recaptcha {
                   14803:     my ($pubkey) = @_;
                   14804:     my $captcha = Captcha::reCAPTCHA->new;
                   14805:     return $captcha->get_options_setter({theme => 'white'})."\n".
                   14806:            $captcha->get_html($pubkey).
                   14807:            &mt('If either word is hard to read, [_1] will replace them.',
1.1133    raeburn  14808:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1094    raeburn  14809:            '<br /><br />';
                   14810: }
                   14811: 
                   14812: sub check_recaptcha {
                   14813:     my ($privkey) = @_;
                   14814:     my $captcha_chk;
                   14815:     my $captcha = Captcha::reCAPTCHA->new;
                   14816:     my $captcha_result =
                   14817:         $captcha->check_answer(
                   14818:                                 $privkey,
                   14819:                                 $ENV{'REMOTE_ADDR'},
                   14820:                                 $env{'form.recaptcha_challenge_field'},
                   14821:                                 $env{'form.recaptcha_response_field'},
                   14822:                               );
                   14823:     if ($captcha_result->{is_valid}) {
                   14824:         $captcha_chk = 1;
                   14825:     }
                   14826:     return $captcha_chk;
                   14827: }
                   14828: 
1.41      ng       14829: =pod
                   14830: 
                   14831: =back
                   14832: 
1.112     bowersj2 14833: =cut
1.41      ng       14834: 
1.112     bowersj2 14835: 1;
                   14836: __END__;
1.41      ng       14837: 

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