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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1158  ! raeburn     4: # $Id: loncommon.pm,v 1.1157 2013/09/29 00:49:28 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 {
1.1154    raeburn  1396:     my ($httphost) = @_;
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();
1.1154    raeburn  1401:     my $details_link = $httphost.'/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,
1.1154    raeburn  1407:                                         'use_absolute' => $httphost,
1.331     albertel 1408: 					'add_entries' => {
                   1409: 					    'border' => '0',
1.579     raeburn  1410: 					    'rows'   => "110,*",},});
1.331     albertel 1411:     my $end_page =
                   1412:         &Apache::loncommon::end_page({'frameset' => 1,
                   1413: 				      'js_ready' => 1,});
                   1414: 
1.436     albertel 1415:     my $template .= <<"ENDTEMPLATE";
                   1416: <script type="text/javascript">
1.877     bisitz   1417: // <![CDATA[
1.253     albertel 1418: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1419: var banner_link = '';
1.243     raeburn  1420: function helpMenu(target) {
                   1421:     var caller = this;
                   1422:     if (target == 'open') {
                   1423:         var newWindow = null;
                   1424:         try {
1.262     albertel 1425:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1426:         }
                   1427:         catch(error) {
                   1428:             writeHelp(caller);
                   1429:             return;
                   1430:         }
                   1431:         if (newWindow) {
                   1432:             caller = newWindow;
                   1433:         }
1.193     raeburn  1434:     }
1.243     raeburn  1435:     writeHelp(caller);
                   1436:     return;
                   1437: }
                   1438: function writeHelp(caller) {
1.1072    raeburn  1439:     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  1440:     caller.document.close()
                   1441:     caller.focus()
1.193     raeburn  1442: }
1.877     bisitz   1443: // END LON-CAPA Internal -->
1.253     albertel 1444: // ]]>
1.436     albertel 1445: </script>
1.193     raeburn  1446: ENDTEMPLATE
                   1447:     return $template;
                   1448: }
                   1449: 
1.172     www      1450: sub help_open_bug {
                   1451:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1452:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1453:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1454:     $text = "" if (not defined $text);
                   1455: 	$stayOnPage=1;
1.184     albertel 1456:     $width = 600 if (not defined $width);
                   1457:     $height = 600 if (not defined $height);
1.172     www      1458: 
                   1459:     $topic=~s/\W+/\+/g;
                   1460:     my $link='';
                   1461:     my $template='';
1.379     albertel 1462:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1463: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1464:     if (!$stayOnPage)
                   1465:     {
                   1466: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1467:     }
                   1468:     else
                   1469:     {
                   1470: 	$link = $url;
                   1471:     }
                   1472:     # Add the text
                   1473:     if ($text ne "")
                   1474:     {
                   1475: 	$template .= 
                   1476:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1477:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1478:     }
                   1479: 
                   1480:     # Add the graphic
1.179     matthew  1481:     my $title = &mt('Report a Bug');
1.215     albertel 1482:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1483:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1484:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1485: ENDTEMPLATE
                   1486:     if ($text ne '') { $template.='</td></tr></table>' };
                   1487:     return $template;
                   1488: 
                   1489: }
                   1490: 
                   1491: sub help_open_faq {
                   1492:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1493:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1494:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1495:     $text = "" if (not defined $text);
                   1496: 	$stayOnPage=1;
                   1497:     $width = 350 if (not defined $width);
                   1498:     $height = 400 if (not defined $height);
                   1499: 
                   1500:     $topic=~s/\W+/\+/g;
                   1501:     my $link='';
                   1502:     my $template='';
                   1503:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1504:     if (!$stayOnPage)
                   1505:     {
                   1506: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1507:     }
                   1508:     else
                   1509:     {
                   1510: 	$link = $url;
                   1511:     }
                   1512: 
                   1513:     # Add the text
                   1514:     if ($text ne "")
                   1515:     {
                   1516: 	$template .= 
1.173     www      1517:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1518:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1519:     }
                   1520: 
                   1521:     # Add the graphic
1.179     matthew  1522:     my $title = &mt('View the FAQ');
1.215     albertel 1523:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1524:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1525:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1526: ENDTEMPLATE
                   1527:     if ($text ne '') { $template.='</td></tr></table>' };
                   1528:     return $template;
                   1529: 
1.44      bowersj2 1530: }
1.37      matthew  1531: 
1.180     matthew  1532: ###############################################################
                   1533: ###############################################################
                   1534: 
1.45      matthew  1535: =pod
                   1536: 
1.648     raeburn  1537: =item * &change_content_javascript():
1.256     matthew  1538: 
                   1539: This and the next function allow you to create small sections of an
                   1540: otherwise static HTML page that you can update on the fly with
                   1541: Javascript, even in Netscape 4.
                   1542: 
                   1543: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1544: must be written to the HTML page once. It will prove the Javascript
                   1545: function "change(name, content)". Calling the change function with the
                   1546: name of the section 
                   1547: you want to update, matching the name passed to C<changable_area>, and
                   1548: the new content you want to put in there, will put the content into
                   1549: that area.
                   1550: 
                   1551: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1552: to contain room for the original contents. You need to "make space"
                   1553: for whatever changes you wish to make, and be B<sure> to check your
                   1554: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1555: it's adequate for updating a one-line status display, but little more.
                   1556: This script will set the space to 100% width, so you only need to
                   1557: worry about height in Netscape 4.
                   1558: 
                   1559: Modern browsers are much less limiting, and if you can commit to the
                   1560: user not using Netscape 4, this feature may be used freely with
                   1561: pretty much any HTML.
                   1562: 
                   1563: =cut
                   1564: 
                   1565: sub change_content_javascript {
                   1566:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1567:     if ($env{'browser.type'} eq 'netscape' &&
                   1568: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1569: 	return (<<NETSCAPE4);
                   1570: 	function change(name, content) {
                   1571: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1572: 	    doc.open();
                   1573: 	    doc.write(content);
                   1574: 	    doc.close();
                   1575: 	}
                   1576: NETSCAPE4
                   1577:     } else {
                   1578: 	# Otherwise, we need to use semi-standards-compliant code
                   1579: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1580: 	# is really scary, and every useful browser supports it
                   1581: 	return (<<DOMBASED);
                   1582: 	function change(name, content) {
                   1583: 	    element = document.getElementById(name);
                   1584: 	    element.innerHTML = content;
                   1585: 	}
                   1586: DOMBASED
                   1587:     }
                   1588: }
                   1589: 
                   1590: =pod
                   1591: 
1.648     raeburn  1592: =item * &changable_area($name,$origContent):
1.256     matthew  1593: 
                   1594: This provides a "changable area" that can be modified on the fly via
                   1595: the Javascript code provided in C<change_content_javascript>. $name is
                   1596: the name you will use to reference the area later; do not repeat the
                   1597: same name on a given HTML page more then once. $origContent is what
                   1598: the area will originally contain, which can be left blank.
                   1599: 
                   1600: =cut
                   1601: 
                   1602: sub changable_area {
                   1603:     my ($name, $origContent) = @_;
                   1604: 
1.258     albertel 1605:     if ($env{'browser.type'} eq 'netscape' &&
                   1606: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1607: 	# If this is netscape 4, we need to use the Layer tag
                   1608: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1609:     } else {
                   1610: 	return "<span id='$name'>$origContent</span>";
                   1611:     }
                   1612: }
                   1613: 
                   1614: =pod
                   1615: 
1.648     raeburn  1616: =item * &viewport_geometry_js 
1.590     raeburn  1617: 
                   1618: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1619: 
                   1620: =cut
                   1621: 
                   1622: 
                   1623: sub viewport_geometry_js { 
                   1624:     return <<"GEOMETRY";
                   1625: var Geometry = {};
                   1626: function init_geometry() {
                   1627:     if (Geometry.init) { return };
                   1628:     Geometry.init=1;
                   1629:     if (window.innerHeight) {
                   1630:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1631:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1632:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1633:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1634:     }
                   1635:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1636:         Geometry.getViewportHeight =
                   1637:             function() { return document.documentElement.clientHeight; };
                   1638:         Geometry.getViewportWidth =
                   1639:             function() { return document.documentElement.clientWidth; };
                   1640: 
                   1641:         Geometry.getHorizontalScroll =
                   1642:             function() { return document.documentElement.scrollLeft; };
                   1643:         Geometry.getVerticalScroll =
                   1644:             function() { return document.documentElement.scrollTop; };
                   1645:     }
                   1646:     else if (document.body.clientHeight) {
                   1647:         Geometry.getViewportHeight =
                   1648:             function() { return document.body.clientHeight; };
                   1649:         Geometry.getViewportWidth =
                   1650:             function() { return document.body.clientWidth; };
                   1651:         Geometry.getHorizontalScroll =
                   1652:             function() { return document.body.scrollLeft; };
                   1653:         Geometry.getVerticalScroll =
                   1654:             function() { return document.body.scrollTop; };
                   1655:     }
                   1656: }
                   1657: 
                   1658: GEOMETRY
                   1659: }
                   1660: 
                   1661: =pod
                   1662: 
1.648     raeburn  1663: =item * &viewport_size_js()
1.590     raeburn  1664: 
                   1665: 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. 
                   1666: 
                   1667: =cut
                   1668: 
                   1669: sub viewport_size_js {
                   1670:     my $geometry = &viewport_geometry_js();
                   1671:     return <<"DIMS";
                   1672: 
                   1673: $geometry
                   1674: 
                   1675: function getViewportDims(width,height) {
                   1676:     init_geometry();
                   1677:     width.value = Geometry.getViewportWidth();
                   1678:     height.value = Geometry.getViewportHeight();
                   1679:     return;
                   1680: }
                   1681: 
                   1682: DIMS
                   1683: }
                   1684: 
                   1685: =pod
                   1686: 
1.648     raeburn  1687: =item * &resize_textarea_js()
1.565     albertel 1688: 
                   1689: emits the needed javascript to resize a textarea to be as big as possible
                   1690: 
                   1691: creates a function resize_textrea that takes two IDs first should be
                   1692: the id of the element to resize, second should be the id of a div that
                   1693: surrounds everything that comes after the textarea, this routine needs
                   1694: to be attached to the <body> for the onload and onresize events.
                   1695: 
1.648     raeburn  1696: =back
1.565     albertel 1697: 
                   1698: =cut
                   1699: 
                   1700: sub resize_textarea_js {
1.590     raeburn  1701:     my $geometry = &viewport_geometry_js();
1.565     albertel 1702:     return <<"RESIZE";
                   1703:     <script type="text/javascript">
1.824     bisitz   1704: // <![CDATA[
1.590     raeburn  1705: $geometry
1.565     albertel 1706: 
1.588     albertel 1707: function getX(element) {
                   1708:     var x = 0;
                   1709:     while (element) {
                   1710: 	x += element.offsetLeft;
                   1711: 	element = element.offsetParent;
                   1712:     }
                   1713:     return x;
                   1714: }
                   1715: function getY(element) {
                   1716:     var y = 0;
                   1717:     while (element) {
                   1718: 	y += element.offsetTop;
                   1719: 	element = element.offsetParent;
                   1720:     }
                   1721:     return y;
                   1722: }
                   1723: 
                   1724: 
1.565     albertel 1725: function resize_textarea(textarea_id,bottom_id) {
                   1726:     init_geometry();
                   1727:     var textarea        = document.getElementById(textarea_id);
                   1728:     //alert(textarea);
                   1729: 
1.588     albertel 1730:     var textarea_top    = getY(textarea);
1.565     albertel 1731:     var textarea_height = textarea.offsetHeight;
                   1732:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1733:     var bottom_top      = getY(bottom);
1.565     albertel 1734:     var bottom_height   = bottom.offsetHeight;
                   1735:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1736:     var fudge           = 23;
1.565     albertel 1737:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1738:     if (new_height < 300) {
                   1739: 	new_height = 300;
                   1740:     }
                   1741:     textarea.style.height=new_height+'px';
                   1742: }
1.824     bisitz   1743: // ]]>
1.565     albertel 1744: </script>
                   1745: RESIZE
                   1746: 
                   1747: }
                   1748: 
                   1749: =pod
                   1750: 
1.256     matthew  1751: =head1 Excel and CSV file utility routines
                   1752: 
                   1753: =over 4
                   1754: 
                   1755: =cut
                   1756: 
                   1757: ###############################################################
                   1758: ###############################################################
                   1759: 
                   1760: =pod
                   1761: 
1.648     raeburn  1762: =item * &csv_translate($text) 
1.37      matthew  1763: 
1.185     www      1764: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1765: format.
                   1766: 
                   1767: =cut
                   1768: 
1.180     matthew  1769: ###############################################################
                   1770: ###############################################################
1.37      matthew  1771: sub csv_translate {
                   1772:     my $text = shift;
                   1773:     $text =~ s/\"/\"\"/g;
1.209     albertel 1774:     $text =~ s/\n/ /g;
1.37      matthew  1775:     return $text;
                   1776: }
1.180     matthew  1777: 
                   1778: ###############################################################
                   1779: ###############################################################
                   1780: 
                   1781: =pod
                   1782: 
1.648     raeburn  1783: =item * &define_excel_formats()
1.180     matthew  1784: 
                   1785: Define some commonly used Excel cell formats.
                   1786: 
                   1787: Currently supported formats:
                   1788: 
                   1789: =over 4
                   1790: 
                   1791: =item header
                   1792: 
                   1793: =item bold
                   1794: 
                   1795: =item h1
                   1796: 
                   1797: =item h2
                   1798: 
                   1799: =item h3
                   1800: 
1.256     matthew  1801: =item h4
                   1802: 
                   1803: =item i
                   1804: 
1.180     matthew  1805: =item date
                   1806: 
                   1807: =back
                   1808: 
                   1809: Inputs: $workbook
                   1810: 
                   1811: Returns: $format, a hash reference.
                   1812: 
1.1057    foxr     1813: 
1.180     matthew  1814: =cut
                   1815: 
                   1816: ###############################################################
                   1817: ###############################################################
                   1818: sub define_excel_formats {
                   1819:     my ($workbook) = @_;
                   1820:     my $format;
                   1821:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1822:                                                 bottom    => 1,
                   1823:                                                 align     => 'center');
                   1824:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1825:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1826:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1827:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1828:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1829:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1830:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1831:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1832:     return $format;
                   1833: }
                   1834: 
                   1835: ###############################################################
                   1836: ###############################################################
1.113     bowersj2 1837: 
                   1838: =pod
                   1839: 
1.648     raeburn  1840: =item * &create_workbook()
1.255     matthew  1841: 
                   1842: Create an Excel worksheet.  If it fails, output message on the
                   1843: request object and return undefs.
                   1844: 
                   1845: Inputs: Apache request object
                   1846: 
                   1847: Returns (undef) on failure, 
                   1848:     Excel worksheet object, scalar with filename, and formats 
                   1849:     from &Apache::loncommon::define_excel_formats on success
                   1850: 
                   1851: =cut
                   1852: 
                   1853: ###############################################################
                   1854: ###############################################################
                   1855: sub create_workbook {
                   1856:     my ($r) = @_;
                   1857:         #
                   1858:     # Create the excel spreadsheet
                   1859:     my $filename = '/prtspool/'.
1.258     albertel 1860:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1861:         time.'_'.rand(1000000000).'.xls';
                   1862:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1863:     if (! defined($workbook)) {
                   1864:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1865:         $r->print(
                   1866:             '<p class="LC_error">'
                   1867:            .&mt('Problems occurred in creating the new Excel file.')
                   1868:            .' '.&mt('This error has been logged.')
                   1869:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1870:            .'</p>'
                   1871:         );
1.255     matthew  1872:         return (undef);
                   1873:     }
                   1874:     #
1.1014    foxr     1875:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1876:     #
                   1877:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1878:     return ($workbook,$filename,$format);
                   1879: }
                   1880: 
                   1881: ###############################################################
                   1882: ###############################################################
                   1883: 
                   1884: =pod
                   1885: 
1.648     raeburn  1886: =item * &create_text_file()
1.113     bowersj2 1887: 
1.542     raeburn  1888: Create a file to write to and eventually make available to the user.
1.256     matthew  1889: If file creation fails, outputs an error message on the request object and 
                   1890: return undefs.
1.113     bowersj2 1891: 
1.256     matthew  1892: Inputs: Apache request object, and file suffix
1.113     bowersj2 1893: 
1.256     matthew  1894: Returns (undef) on failure, 
                   1895:     Filehandle and filename on success.
1.113     bowersj2 1896: 
                   1897: =cut
                   1898: 
1.256     matthew  1899: ###############################################################
                   1900: ###############################################################
                   1901: sub create_text_file {
                   1902:     my ($r,$suffix) = @_;
                   1903:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1904:     my $fh;
                   1905:     my $filename = '/prtspool/'.
1.258     albertel 1906:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1907:         time.'_'.rand(1000000000).'.'.$suffix;
                   1908:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1909:     if (! defined($fh)) {
                   1910:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1911:         $r->print(
                   1912:             '<p class="LC_error">'
                   1913:            .&mt('Problems occurred in creating the output file.')
                   1914:            .' '.&mt('This error has been logged.')
                   1915:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1916:            .'</p>'
                   1917:         );
1.113     bowersj2 1918:     }
1.256     matthew  1919:     return ($fh,$filename)
1.113     bowersj2 1920: }
                   1921: 
                   1922: 
1.256     matthew  1923: =pod 
1.113     bowersj2 1924: 
                   1925: =back
                   1926: 
                   1927: =cut
1.37      matthew  1928: 
                   1929: ###############################################################
1.33      matthew  1930: ##        Home server <option> list generating code          ##
                   1931: ###############################################################
1.35      matthew  1932: 
1.169     www      1933: # ------------------------------------------
                   1934: 
                   1935: sub domain_select {
                   1936:     my ($name,$value,$multiple)=@_;
                   1937:     my %domains=map { 
1.514     albertel 1938: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1939:     } &Apache::lonnet::all_domains();
1.169     www      1940:     if ($multiple) {
                   1941: 	$domains{''}=&mt('Any domain');
1.550     albertel 1942: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1943: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1944:     } else {
1.550     albertel 1945: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1946: 	return &select_form($name,$value,\%domains);
1.169     www      1947:     }
                   1948: }
                   1949: 
1.282     albertel 1950: #-------------------------------------------
                   1951: 
                   1952: =pod
                   1953: 
1.519     raeburn  1954: =head1 Routines for form select boxes
                   1955: 
                   1956: =over 4
                   1957: 
1.648     raeburn  1958: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1959: 
                   1960: Returns a string containing a <select> element int multiple mode
                   1961: 
                   1962: 
                   1963: Args:
                   1964:   $name - name of the <select> element
1.506     raeburn  1965:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1966:   $size - number of rows long the select element is
1.283     albertel 1967:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1968:           (shown text should already have been &mt())
1.506     raeburn  1969:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1970: 
1.282     albertel 1971: =cut
                   1972: 
                   1973: #-------------------------------------------
1.169     www      1974: sub multiple_select_form {
1.284     albertel 1975:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1976:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1977:     my $output='';
1.191     matthew  1978:     if (! defined($size)) {
                   1979:         $size = 4;
1.283     albertel 1980:         if (scalar(keys(%$hash))<4) {
                   1981:             $size = scalar(keys(%$hash));
1.191     matthew  1982:         }
                   1983:     }
1.734     bisitz   1984:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1985:     my @order;
1.506     raeburn  1986:     if (ref($order) eq 'ARRAY')  {
                   1987:         @order = @{$order};
                   1988:     } else {
                   1989:         @order = sort(keys(%$hash));
1.501     banghart 1990:     }
                   1991:     if (exists($$hash{'select_form_order'})) {
                   1992:         @order = @{$$hash{'select_form_order'}};
                   1993:     }
                   1994:         
1.284     albertel 1995:     foreach my $key (@order) {
1.356     albertel 1996:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1997:         $output.='selected="selected" ' if ($selected{$key});
                   1998:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1999:     }
                   2000:     $output.="</select>\n";
                   2001:     return $output;
                   2002: }
                   2003: 
1.88      www      2004: #-------------------------------------------
                   2005: 
                   2006: =pod
                   2007: 
1.970     raeburn  2008: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      2009: 
                   2010: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2011: allow a user to select options from a ref to a hash containing:
                   2012: option_name => displayed text. An optional $onchange can include
                   2013: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   2014: 
1.88      www      2015: See lonrights.pm for an example invocation and use.
                   2016: 
                   2017: =cut
                   2018: 
                   2019: #-------------------------------------------
                   2020: sub select_form {
1.970     raeburn  2021:     my ($def,$name,$hashref,$onchange) = @_;
                   2022:     return unless (ref($hashref) eq 'HASH');
                   2023:     if ($onchange) {
                   2024:         $onchange = ' onchange="'.$onchange.'"';
                   2025:     }
                   2026:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 2027:     my @keys;
1.970     raeburn  2028:     if (exists($hashref->{'select_form_order'})) {
                   2029: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2030:     } else {
1.970     raeburn  2031: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2032:     }
1.356     albertel 2033:     foreach my $key (@keys) {
                   2034:         $selectform.=
                   2035: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2036:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2037:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2038:     }
                   2039:     $selectform.="</select>";
                   2040:     return $selectform;
                   2041: }
                   2042: 
1.475     www      2043: # For display filters
                   2044: 
                   2045: sub display_filter {
1.1074    raeburn  2046:     my ($context) = @_;
1.475     www      2047:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2048:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2049:     my $phraseinput = 'hidden';
                   2050:     my $includeinput = 'hidden';
                   2051:     my ($checked,$includetypestext);
                   2052:     if ($env{'form.displayfilter'} eq 'containing') {
                   2053:         $phraseinput = 'text'; 
                   2054:         if ($context eq 'parmslog') {
                   2055:             $includeinput = 'checkbox';
                   2056:             if ($env{'form.includetypes'}) {
                   2057:                 $checked = ' checked="checked"';
                   2058:             }
                   2059:             $includetypestext = &mt('Include parameter types');
                   2060:         }
                   2061:     } else {
                   2062:         $includetypestext = '&nbsp;';
                   2063:     }
                   2064:     my ($additional,$secondid,$thirdid);
                   2065:     if ($context eq 'parmslog') {
                   2066:         $additional = 
                   2067:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2068:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2069:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2070:             '</label>';
                   2071:         $secondid = 'includetypes';
                   2072:         $thirdid = 'includetypestext';
                   2073:     }
                   2074:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2075:                                                     '$secondid','$thirdid')";
                   2076:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2077: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2078: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2079: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2080:            &mt('Filter: [_1]',
1.477     www      2081: 	   &select_form($env{'form.displayfilter'},
                   2082: 			'displayfilter',
1.970     raeburn  2083: 			{'currentfolder' => 'Current folder/page',
1.477     www      2084: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2085: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2086: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2087:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2088:                          '" />'.$additional;
                   2089: }
                   2090: 
                   2091: sub display_filter_js {
                   2092:     my $includetext = &mt('Include parameter types');
                   2093:     return <<"ENDJS";
                   2094:   
                   2095: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2096:     var firstType = 'hidden';
                   2097:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2098:         firstType = 'text';
                   2099:     }
                   2100:     firstObject = document.getElementById(firstid);
                   2101:     if (typeof(firstObject) == 'object') {
                   2102:         if (firstObject.type != firstType) {
                   2103:             changeInputType(firstObject,firstType);
                   2104:         }
                   2105:     }
                   2106:     if (context == 'parmslog') {
                   2107:         var secondType = 'hidden';
                   2108:         if (firstType == 'text') {
                   2109:             secondType = 'checkbox';
                   2110:         }
                   2111:         secondObject = document.getElementById(secondid);  
                   2112:         if (typeof(secondObject) == 'object') {
                   2113:             if (secondObject.type != secondType) {
                   2114:                 changeInputType(secondObject,secondType);
                   2115:             }
                   2116:         }
                   2117:         var textItem = document.getElementById(thirdid);
                   2118:         var currtext = textItem.innerHTML;
                   2119:         var newtext;
                   2120:         if (firstType == 'text') {
                   2121:             newtext = '$includetext';
                   2122:         } else {
                   2123:             newtext = '&nbsp;';
                   2124:         }
                   2125:         if (currtext != newtext) {
                   2126:             textItem.innerHTML = newtext;
                   2127:         }
                   2128:     }
                   2129:     return;
                   2130: }
                   2131: 
                   2132: function changeInputType(oldObject,newType) {
                   2133:     var newObject = document.createElement('input');
                   2134:     newObject.type = newType;
                   2135:     if (oldObject.size) {
                   2136:         newObject.size = oldObject.size;
                   2137:     }
                   2138:     if (oldObject.value) {
                   2139:         newObject.value = oldObject.value;
                   2140:     }
                   2141:     if (oldObject.name) {
                   2142:         newObject.name = oldObject.name;
                   2143:     }
                   2144:     if (oldObject.id) {
                   2145:         newObject.id = oldObject.id;
                   2146:     }
                   2147:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2148:     return;
                   2149: }
                   2150: 
                   2151: ENDJS
1.475     www      2152: }
                   2153: 
1.167     www      2154: sub gradeleveldescription {
                   2155:     my $gradelevel=shift;
                   2156:     my %gradelevels=(0 => 'Not specified',
                   2157: 		     1 => 'Grade 1',
                   2158: 		     2 => 'Grade 2',
                   2159: 		     3 => 'Grade 3',
                   2160: 		     4 => 'Grade 4',
                   2161: 		     5 => 'Grade 5',
                   2162: 		     6 => 'Grade 6',
                   2163: 		     7 => 'Grade 7',
                   2164: 		     8 => 'Grade 8',
                   2165: 		     9 => 'Grade 9',
                   2166: 		     10 => 'Grade 10',
                   2167: 		     11 => 'Grade 11',
                   2168: 		     12 => 'Grade 12',
                   2169: 		     13 => 'Grade 13',
                   2170: 		     14 => '100 Level',
                   2171: 		     15 => '200 Level',
                   2172: 		     16 => '300 Level',
                   2173: 		     17 => '400 Level',
                   2174: 		     18 => 'Graduate Level');
                   2175:     return &mt($gradelevels{$gradelevel});
                   2176: }
                   2177: 
1.163     www      2178: sub select_level_form {
                   2179:     my ($deflevel,$name)=@_;
                   2180:     unless ($deflevel) { $deflevel=0; }
1.167     www      2181:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2182:     for (my $i=0; $i<=18; $i++) {
                   2183:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2184:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2185:                 ">".&gradeleveldescription($i)."</option>\n";
                   2186:     }
                   2187:     $selectform.="</select>";
                   2188:     return $selectform;
1.163     www      2189: }
1.167     www      2190: 
1.35      matthew  2191: #-------------------------------------------
                   2192: 
1.45      matthew  2193: =pod
                   2194: 
1.1121    raeburn  2195: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2196: 
                   2197: Returns a string containing a <select name='$name' size='1'> form to 
                   2198: allow a user to select the domain to preform an operation in.  
                   2199: See loncreateuser.pm for an example invocation and use.
                   2200: 
1.90      www      2201: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2202: selected");
                   2203: 
1.743     raeburn  2204: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2205: 
1.910     raeburn  2206: 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.
                   2207: 
1.1121    raeburn  2208: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2209: 
                   2210: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563     raeburn  2211: 
1.35      matthew  2212: =cut
                   2213: 
                   2214: #-------------------------------------------
1.34      matthew  2215: sub select_dom_form {
1.1121    raeburn  2216:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2217:     if ($onchange) {
1.874     raeburn  2218:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2219:     }
1.1121    raeburn  2220:     my (@domains,%exclude);
1.910     raeburn  2221:     if (ref($incdoms) eq 'ARRAY') {
                   2222:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2223:     } else {
                   2224:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2225:     }
1.90      www      2226:     if ($includeempty) { @domains=('',@domains); }
1.1121    raeburn  2227:     if (ref($excdoms) eq 'ARRAY') {
                   2228:         map { $exclude{$_} = 1; } @{$excdoms}; 
                   2229:     }
1.743     raeburn  2230:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2231:     foreach my $dom (@domains) {
1.1121    raeburn  2232:         next if ($exclude{$dom});
1.356     albertel 2233:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2234:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2235:         if ($showdomdesc) {
                   2236:             if ($dom ne '') {
                   2237:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2238:                 if ($domdesc ne '') {
                   2239:                     $selectdomain .= ' ('.$domdesc.')';
                   2240:                 }
                   2241:             } 
                   2242:         }
                   2243:         $selectdomain .= "</option>\n";
1.34      matthew  2244:     }
                   2245:     $selectdomain.="</select>";
                   2246:     return $selectdomain;
                   2247: }
                   2248: 
1.35      matthew  2249: #-------------------------------------------
                   2250: 
1.45      matthew  2251: =pod
                   2252: 
1.648     raeburn  2253: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2254: 
1.586     raeburn  2255: input: 4 arguments (two required, two optional) - 
                   2256:     $domain - domain of new user
                   2257:     $name - name of form element
                   2258:     $default - Value of 'default' causes a default item to be first 
                   2259:                             option, and selected by default. 
                   2260:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2261:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2262: output: returns 2 items: 
1.586     raeburn  2263: (a) form element which contains either:
                   2264:    (i) <select name="$name">
                   2265:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2266:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2267:        </select>
                   2268:        form item if there are multiple library servers in $domain, or
                   2269:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2270:        if there is only one library server in $domain.
                   2271: 
                   2272: (b) number of library servers found.
                   2273: 
                   2274: See loncreateuser.pm for example of use.
1.35      matthew  2275: 
                   2276: =cut
                   2277: 
                   2278: #-------------------------------------------
1.586     raeburn  2279: sub home_server_form_item {
                   2280:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2281:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2282:     my $result;
                   2283:     my $numlib = keys(%servers);
                   2284:     if ($numlib > 1) {
                   2285:         $result .= '<select name="'.$name.'" />'."\n";
                   2286:         if ($default) {
1.804     bisitz   2287:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2288:                        '</option>'."\n";
                   2289:         }
                   2290:         foreach my $hostid (sort(keys(%servers))) {
                   2291:             $result.= '<option value="'.$hostid.'">'.
                   2292: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2293:         }
                   2294:         $result .= '</select>'."\n";
                   2295:     } elsif ($numlib == 1) {
                   2296:         my $hostid;
                   2297:         foreach my $item (keys(%servers)) {
                   2298:             $hostid = $item;
                   2299:         }
                   2300:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2301:                    $hostid.'" />';
                   2302:                    if (!$hide) {
                   2303:                        $result .= $hostid.' '.$servers{$hostid};
                   2304:                    }
                   2305:                    $result .= "\n";
                   2306:     } elsif ($default) {
                   2307:         $result .= '<input type="hidden" name="'.$name.
                   2308:                    '" value="default" />';
                   2309:                    if (!$hide) {
                   2310:                        $result .= &mt('default');
                   2311:                    }
                   2312:                    $result .= "\n";
1.33      matthew  2313:     }
1.586     raeburn  2314:     return ($result,$numlib);
1.33      matthew  2315: }
1.112     bowersj2 2316: 
                   2317: =pod
                   2318: 
1.534     albertel 2319: =back 
                   2320: 
1.112     bowersj2 2321: =cut
1.87      matthew  2322: 
                   2323: ###############################################################
1.112     bowersj2 2324: ##                  Decoding User Agent                      ##
1.87      matthew  2325: ###############################################################
                   2326: 
                   2327: =pod
                   2328: 
1.112     bowersj2 2329: =head1 Decoding the User Agent
                   2330: 
                   2331: =over 4
                   2332: 
                   2333: =item * &decode_user_agent()
1.87      matthew  2334: 
                   2335: Inputs: $r
                   2336: 
                   2337: Outputs:
                   2338: 
                   2339: =over 4
                   2340: 
1.112     bowersj2 2341: =item * $httpbrowser
1.87      matthew  2342: 
1.112     bowersj2 2343: =item * $clientbrowser
1.87      matthew  2344: 
1.112     bowersj2 2345: =item * $clientversion
1.87      matthew  2346: 
1.112     bowersj2 2347: =item * $clientmathml
1.87      matthew  2348: 
1.112     bowersj2 2349: =item * $clientunicode
1.87      matthew  2350: 
1.112     bowersj2 2351: =item * $clientos
1.87      matthew  2352: 
1.1137    raeburn  2353: =item * $clientmobile
                   2354: 
1.1141    raeburn  2355: =item * $clientinfo
                   2356: 
1.87      matthew  2357: =back
                   2358: 
1.157     matthew  2359: =back 
                   2360: 
1.87      matthew  2361: =cut
                   2362: 
                   2363: ###############################################################
                   2364: ###############################################################
                   2365: sub decode_user_agent {
1.247     albertel 2366:     my ($r)=@_;
1.87      matthew  2367:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2368:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2369:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2370:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2371:     my $clientbrowser='unknown';
                   2372:     my $clientversion='0';
                   2373:     my $clientmathml='';
                   2374:     my $clientunicode='0';
1.1137    raeburn  2375:     my $clientmobile=0;
1.87      matthew  2376:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2377:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2378: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2379: 	    $clientbrowser=$bname;
                   2380:             $httpbrowser=~/$vreg/i;
                   2381: 	    $clientversion=$1;
                   2382:             $clientmathml=($clientversion>=$minv);
                   2383:             $clientunicode=($clientversion>=$univ);
                   2384: 	}
                   2385:     }
                   2386:     my $clientos='unknown';
1.1141    raeburn  2387:     my $clientinfo;
1.87      matthew  2388:     if (($httpbrowser=~/linux/i) ||
                   2389:         ($httpbrowser=~/unix/i) ||
                   2390:         ($httpbrowser=~/ux/i) ||
                   2391:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2392:     if (($httpbrowser=~/vax/i) ||
                   2393:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2394:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2395:     if (($httpbrowser=~/mac/i) ||
                   2396:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2397:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2398:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137    raeburn  2399:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2400:         $clientmobile=lc($1);
                   2401:     }
1.1141    raeburn  2402:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2403:         $clientinfo = 'firefox-'.$1;
                   2404:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2405:         $clientinfo = 'chromeframe-'.$1;
                   2406:     }
1.87      matthew  2407:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1141    raeburn  2408:             $clientunicode,$clientos,$clientmobile,$clientinfo);
1.87      matthew  2409: }
                   2410: 
1.32      matthew  2411: ###############################################################
                   2412: ##    Authentication changing form generation subroutines    ##
                   2413: ###############################################################
                   2414: ##
                   2415: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2416: ## hash, and have reasonable default values.
                   2417: ##
                   2418: ##    formname = the name given in the <form> tag.
1.35      matthew  2419: #-------------------------------------------
                   2420: 
1.45      matthew  2421: =pod
                   2422: 
1.112     bowersj2 2423: =head1 Authentication Routines
                   2424: 
                   2425: =over 4
                   2426: 
1.648     raeburn  2427: =item * &authform_xxxxxx()
1.35      matthew  2428: 
                   2429: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2430: handle some of the conveniences required for authentication forms.  
                   2431: This is not an optimal method, but it works.  
                   2432: 
                   2433: =over 4
                   2434: 
1.112     bowersj2 2435: =item * authform_header
1.35      matthew  2436: 
1.112     bowersj2 2437: =item * authform_authorwarning
1.35      matthew  2438: 
1.112     bowersj2 2439: =item * authform_nochange
1.35      matthew  2440: 
1.112     bowersj2 2441: =item * authform_kerberos
1.35      matthew  2442: 
1.112     bowersj2 2443: =item * authform_internal
1.35      matthew  2444: 
1.112     bowersj2 2445: =item * authform_filesystem
1.35      matthew  2446: 
                   2447: =back
                   2448: 
1.648     raeburn  2449: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2450: 
1.35      matthew  2451: =cut
                   2452: 
                   2453: #-------------------------------------------
1.32      matthew  2454: sub authform_header{  
                   2455:     my %in = (
                   2456:         formname => 'cu',
1.80      albertel 2457:         kerb_def_dom => '',
1.32      matthew  2458:         @_,
                   2459:     );
                   2460:     $in{'formname'} = 'document.' . $in{'formname'};
                   2461:     my $result='';
1.80      albertel 2462: 
                   2463: #---------------------------------------------- Code for upper case translation
                   2464:     my $Javascript_toUpperCase;
                   2465:     unless ($in{kerb_def_dom}) {
                   2466:         $Javascript_toUpperCase =<<"END";
                   2467:         switch (choice) {
                   2468:            case 'krb': currentform.elements[choicearg].value =
                   2469:                currentform.elements[choicearg].value.toUpperCase();
                   2470:                break;
                   2471:            default:
                   2472:         }
                   2473: END
                   2474:     } else {
                   2475:         $Javascript_toUpperCase = "";
                   2476:     }
                   2477: 
1.165     raeburn  2478:     my $radioval = "'nochange'";
1.591     raeburn  2479:     if (defined($in{'curr_authtype'})) {
                   2480:         if ($in{'curr_authtype'} ne '') {
                   2481:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2482:         }
1.174     matthew  2483:     }
1.165     raeburn  2484:     my $argfield = 'null';
1.591     raeburn  2485:     if (defined($in{'mode'})) {
1.165     raeburn  2486:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2487:             if (defined($in{'curr_autharg'})) {
                   2488:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2489:                     $argfield = "'$in{'curr_autharg'}'";
                   2490:                 }
                   2491:             }
                   2492:         }
                   2493:     }
                   2494: 
1.32      matthew  2495:     $result.=<<"END";
                   2496: var current = new Object();
1.165     raeburn  2497: current.radiovalue = $radioval;
                   2498: current.argfield = $argfield;
1.32      matthew  2499: 
                   2500: function changed_radio(choice,currentform) {
                   2501:     var choicearg = choice + 'arg';
                   2502:     // If a radio button in changed, we need to change the argfield
                   2503:     if (current.radiovalue != choice) {
                   2504:         current.radiovalue = choice;
                   2505:         if (current.argfield != null) {
                   2506:             currentform.elements[current.argfield].value = '';
                   2507:         }
                   2508:         if (choice == 'nochange') {
                   2509:             current.argfield = null;
                   2510:         } else {
                   2511:             current.argfield = choicearg;
                   2512:             switch(choice) {
                   2513:                 case 'krb': 
                   2514:                     currentform.elements[current.argfield].value = 
                   2515:                         "$in{'kerb_def_dom'}";
                   2516:                 break;
                   2517:               default:
                   2518:                 break;
                   2519:             }
                   2520:         }
                   2521:     }
                   2522:     return;
                   2523: }
1.22      www      2524: 
1.32      matthew  2525: function changed_text(choice,currentform) {
                   2526:     var choicearg = choice + 'arg';
                   2527:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2528:         $Javascript_toUpperCase
1.32      matthew  2529:         // clear old field
                   2530:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2531:             currentform.elements[current.argfield].value = '';
                   2532:         }
                   2533:         current.argfield = choicearg;
                   2534:     }
                   2535:     set_auth_radio_buttons(choice,currentform);
                   2536:     return;
1.20      www      2537: }
1.32      matthew  2538: 
                   2539: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2540:     var numauthchoices = currentform.login.length;
                   2541:     if (typeof numauthchoices  == "undefined") {
                   2542:         return;
                   2543:     } 
1.32      matthew  2544:     var i=0;
1.986     raeburn  2545:     while (i < numauthchoices) {
1.32      matthew  2546:         if (currentform.login[i].value == newvalue) { break; }
                   2547:         i++;
                   2548:     }
1.986     raeburn  2549:     if (i == numauthchoices) {
1.32      matthew  2550:         return;
                   2551:     }
                   2552:     current.radiovalue = newvalue;
                   2553:     currentform.login[i].checked = true;
                   2554:     return;
                   2555: }
                   2556: END
                   2557:     return $result;
                   2558: }
                   2559: 
1.1106    raeburn  2560: sub authform_authorwarning {
1.32      matthew  2561:     my $result='';
1.144     matthew  2562:     $result='<i>'.
                   2563:         &mt('As a general rule, only authors or co-authors should be '.
                   2564:             'filesystem authenticated '.
                   2565:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2566:     return $result;
                   2567: }
                   2568: 
1.1106    raeburn  2569: sub authform_nochange {
1.32      matthew  2570:     my %in = (
                   2571:               formname => 'document.cu',
                   2572:               kerb_def_dom => 'MSU.EDU',
                   2573:               @_,
                   2574:           );
1.1106    raeburn  2575:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586     raeburn  2576:     my $result;
1.1104    raeburn  2577:     if (!$authnum) {
1.1105    raeburn  2578:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2579:     } else {
                   2580:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2581:                   '<input type="radio" name="login" value="nochange" '.
                   2582:                   'checked="checked" onclick="'.
1.281     albertel 2583:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2584: 	    '</label>';
1.586     raeburn  2585:     }
1.32      matthew  2586:     return $result;
                   2587: }
                   2588: 
1.591     raeburn  2589: sub authform_kerberos {
1.32      matthew  2590:     my %in = (
                   2591:               formname => 'document.cu',
                   2592:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2593:               kerb_def_auth => 'krb4',
1.32      matthew  2594:               @_,
                   2595:               );
1.586     raeburn  2596:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2597:         $autharg,$jscall);
1.1106    raeburn  2598:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2599:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2600:        $check5 = ' checked="checked"';
1.80      albertel 2601:     } else {
1.772     bisitz   2602:        $check4 = ' checked="checked"';
1.80      albertel 2603:     }
1.165     raeburn  2604:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2605:     if (defined($in{'curr_authtype'})) {
                   2606:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2607:             $krbcheck = ' checked="checked"';
1.623     raeburn  2608:             if (defined($in{'mode'})) {
                   2609:                 if ($in{'mode'} eq 'modifyuser') {
                   2610:                     $krbcheck = '';
                   2611:                 }
                   2612:             }
1.591     raeburn  2613:             if (defined($in{'curr_kerb_ver'})) {
                   2614:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2615:                     $check5 = ' checked="checked"';
1.591     raeburn  2616:                     $check4 = '';
                   2617:                 } else {
1.772     bisitz   2618:                     $check4 = ' checked="checked"';
1.591     raeburn  2619:                     $check5 = '';
                   2620:                 }
1.586     raeburn  2621:             }
1.591     raeburn  2622:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2623:                 $krbarg = $in{'curr_autharg'};
                   2624:             }
1.586     raeburn  2625:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2626:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2627:                     $result = 
                   2628:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2629:         $in{'curr_autharg'},$krbver);
                   2630:                 } else {
                   2631:                     $result =
                   2632:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2633:                 }
                   2634:                 return $result; 
                   2635:             }
                   2636:         }
                   2637:     } else {
                   2638:         if ($authnum == 1) {
1.784     bisitz   2639:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2640:         }
                   2641:     }
1.586     raeburn  2642:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2643:         return;
1.587     raeburn  2644:     } elsif ($authtype eq '') {
1.591     raeburn  2645:         if (defined($in{'mode'})) {
1.587     raeburn  2646:             if ($in{'mode'} eq 'modifycourse') {
                   2647:                 if ($authnum == 1) {
1.1104    raeburn  2648:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2649:                 }
                   2650:             }
                   2651:         }
1.586     raeburn  2652:     }
                   2653:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2654:     if ($authtype eq '') {
                   2655:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2656:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2657:                     $krbcheck.' />';
                   2658:     }
                   2659:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106    raeburn  2660:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2661:          $in{'curr_authtype'} eq 'krb5') ||
1.1106    raeburn  2662:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2663:          $in{'curr_authtype'} eq 'krb4')) {
                   2664:         $result .= &mt
1.144     matthew  2665:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2666:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2667:          '<label>'.$authtype,
1.281     albertel 2668:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2669:              'value="'.$krbarg.'" '.
1.144     matthew  2670:              'onchange="'.$jscall.'" />',
1.281     albertel 2671:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2672:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2673: 	 '</label>');
1.586     raeburn  2674:     } elsif ($can_assign{'krb4'}) {
                   2675:         $result .= &mt
                   2676:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2677:          '[_3] Version 4 [_4]',
                   2678:          '<label>'.$authtype,
                   2679:          '</label><input type="text" size="10" name="krbarg" '.
                   2680:              'value="'.$krbarg.'" '.
                   2681:              'onchange="'.$jscall.'" />',
                   2682:          '<label><input type="hidden" name="krbver" value="4" />',
                   2683:          '</label>');
                   2684:     } elsif ($can_assign{'krb5'}) {
                   2685:         $result .= &mt
                   2686:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2687:          '[_3] Version 5 [_4]',
                   2688:          '<label>'.$authtype,
                   2689:          '</label><input type="text" size="10" name="krbarg" '.
                   2690:              'value="'.$krbarg.'" '.
                   2691:              'onchange="'.$jscall.'" />',
                   2692:          '<label><input type="hidden" name="krbver" value="5" />',
                   2693:          '</label>');
                   2694:     }
1.32      matthew  2695:     return $result;
                   2696: }
                   2697: 
1.1106    raeburn  2698: sub authform_internal {
1.586     raeburn  2699:     my %in = (
1.32      matthew  2700:                 formname => 'document.cu',
                   2701:                 kerb_def_dom => 'MSU.EDU',
                   2702:                 @_,
                   2703:                 );
1.586     raeburn  2704:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2705:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2706:     if (defined($in{'curr_authtype'})) {
                   2707:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2708:             if ($can_assign{'int'}) {
1.772     bisitz   2709:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2710:                 if (defined($in{'mode'})) {
                   2711:                     if ($in{'mode'} eq 'modifyuser') {
                   2712:                         $intcheck = '';
                   2713:                     }
                   2714:                 }
1.591     raeburn  2715:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2716:                     $intarg = $in{'curr_autharg'};
                   2717:                 }
                   2718:             } else {
                   2719:                 $result = &mt('Currently internally authenticated.');
                   2720:                 return $result;
1.165     raeburn  2721:             }
                   2722:         }
1.586     raeburn  2723:     } else {
                   2724:         if ($authnum == 1) {
1.784     bisitz   2725:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2726:         }
                   2727:     }
                   2728:     if (!$can_assign{'int'}) {
                   2729:         return;
1.587     raeburn  2730:     } elsif ($authtype eq '') {
1.591     raeburn  2731:         if (defined($in{'mode'})) {
1.587     raeburn  2732:             if ($in{'mode'} eq 'modifycourse') {
                   2733:                 if ($authnum == 1) {
1.1104    raeburn  2734:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2735:                 }
                   2736:             }
                   2737:         }
1.165     raeburn  2738:     }
1.586     raeburn  2739:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2740:     if ($authtype eq '') {
                   2741:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2742:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2743:     }
1.605     bisitz   2744:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2745:                $intarg.'" onchange="'.$jscall.'" />';
                   2746:     $result = &mt
1.144     matthew  2747:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2748:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2749:     $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  2750:     return $result;
                   2751: }
                   2752: 
1.1104    raeburn  2753: sub authform_local {
1.32      matthew  2754:     my %in = (
                   2755:               formname => 'document.cu',
                   2756:               kerb_def_dom => 'MSU.EDU',
                   2757:               @_,
                   2758:               );
1.586     raeburn  2759:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2760:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2761:     if (defined($in{'curr_authtype'})) {
                   2762:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2763:             if ($can_assign{'loc'}) {
1.772     bisitz   2764:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2765:                 if (defined($in{'mode'})) {
                   2766:                     if ($in{'mode'} eq 'modifyuser') {
                   2767:                         $loccheck = '';
                   2768:                     }
                   2769:                 }
1.591     raeburn  2770:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2771:                     $locarg = $in{'curr_autharg'};
                   2772:                 }
                   2773:             } else {
                   2774:                 $result = &mt('Currently using local (institutional) authentication.');
                   2775:                 return $result;
1.165     raeburn  2776:             }
                   2777:         }
1.586     raeburn  2778:     } else {
                   2779:         if ($authnum == 1) {
1.784     bisitz   2780:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2781:         }
                   2782:     }
                   2783:     if (!$can_assign{'loc'}) {
                   2784:         return;
1.587     raeburn  2785:     } elsif ($authtype eq '') {
1.591     raeburn  2786:         if (defined($in{'mode'})) {
1.587     raeburn  2787:             if ($in{'mode'} eq 'modifycourse') {
                   2788:                 if ($authnum == 1) {
1.1104    raeburn  2789:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2790:                 }
                   2791:             }
                   2792:         }
1.165     raeburn  2793:     }
1.586     raeburn  2794:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2795:     if ($authtype eq '') {
                   2796:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2797:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2798:                     $jscall.'" />';
                   2799:     }
                   2800:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2801:                $locarg.'" onchange="'.$jscall.'" />';
                   2802:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2803:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2804:     return $result;
                   2805: }
                   2806: 
1.1106    raeburn  2807: sub authform_filesystem {
1.32      matthew  2808:     my %in = (
                   2809:               formname => 'document.cu',
                   2810:               kerb_def_dom => 'MSU.EDU',
                   2811:               @_,
                   2812:               );
1.586     raeburn  2813:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2814:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2815:     if (defined($in{'curr_authtype'})) {
                   2816:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2817:             if ($can_assign{'fsys'}) {
1.772     bisitz   2818:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2819:                 if (defined($in{'mode'})) {
                   2820:                     if ($in{'mode'} eq 'modifyuser') {
                   2821:                         $fsyscheck = '';
                   2822:                     }
                   2823:                 }
1.586     raeburn  2824:             } else {
                   2825:                 $result = &mt('Currently Filesystem Authenticated.');
                   2826:                 return $result;
                   2827:             }           
                   2828:         }
                   2829:     } else {
                   2830:         if ($authnum == 1) {
1.784     bisitz   2831:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2832:         }
                   2833:     }
                   2834:     if (!$can_assign{'fsys'}) {
                   2835:         return;
1.587     raeburn  2836:     } elsif ($authtype eq '') {
1.591     raeburn  2837:         if (defined($in{'mode'})) {
1.587     raeburn  2838:             if ($in{'mode'} eq 'modifycourse') {
                   2839:                 if ($authnum == 1) {
1.1104    raeburn  2840:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2841:                 }
                   2842:             }
                   2843:         }
1.586     raeburn  2844:     }
                   2845:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2846:     if ($authtype eq '') {
                   2847:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2848:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2849:                     $jscall.'" />';
                   2850:     }
                   2851:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2852:                ' onchange="'.$jscall.'" />';
                   2853:     $result = &mt
1.144     matthew  2854:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2855:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2856:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2857:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2858:                   'onchange="'.$jscall.'" />');
1.32      matthew  2859:     return $result;
                   2860: }
                   2861: 
1.586     raeburn  2862: sub get_assignable_auth {
                   2863:     my ($dom) = @_;
                   2864:     if ($dom eq '') {
                   2865:         $dom = $env{'request.role.domain'};
                   2866:     }
                   2867:     my %can_assign = (
                   2868:                           krb4 => 1,
                   2869:                           krb5 => 1,
                   2870:                           int  => 1,
                   2871:                           loc  => 1,
                   2872:                      );
                   2873:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2874:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2875:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2876:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2877:             my $context;
                   2878:             if ($env{'request.role'} =~ /^au/) {
                   2879:                 $context = 'author';
                   2880:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2881:                 $context = 'domain';
                   2882:             } elsif ($env{'request.course.id'}) {
                   2883:                 $context = 'course';
                   2884:             }
                   2885:             if ($context) {
                   2886:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2887:                    %can_assign = %{$authhash->{$context}}; 
                   2888:                 }
                   2889:             }
                   2890:         }
                   2891:     }
                   2892:     my $authnum = 0;
                   2893:     foreach my $key (keys(%can_assign)) {
                   2894:         if ($can_assign{$key}) {
                   2895:             $authnum ++;
                   2896:         }
                   2897:     }
                   2898:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2899:         $authnum --;
                   2900:     }
                   2901:     return ($authnum,%can_assign);
                   2902: }
                   2903: 
1.80      albertel 2904: ###############################################################
                   2905: ##    Get Kerberos Defaults for Domain                 ##
                   2906: ###############################################################
                   2907: ##
                   2908: ## Returns default kerberos version and an associated argument
                   2909: ## as listed in file domain.tab. If not listed, provides
                   2910: ## appropriate default domain and kerberos version.
                   2911: ##
                   2912: #-------------------------------------------
                   2913: 
                   2914: =pod
                   2915: 
1.648     raeburn  2916: =item * &get_kerberos_defaults()
1.80      albertel 2917: 
                   2918: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2919: version and domain. If not found, it defaults to version 4 and the 
                   2920: domain of the server.
1.80      albertel 2921: 
1.648     raeburn  2922: =over 4
                   2923: 
1.80      albertel 2924: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2925: 
1.648     raeburn  2926: =back
                   2927: 
                   2928: =back
                   2929: 
1.80      albertel 2930: =cut
                   2931: 
                   2932: #-------------------------------------------
                   2933: sub get_kerberos_defaults {
                   2934:     my $domain=shift;
1.641     raeburn  2935:     my ($krbdef,$krbdefdom);
                   2936:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2937:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2938:         $krbdef = $domdefaults{'auth_def'};
                   2939:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2940:     } else {
1.80      albertel 2941:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2942:         my $krbdefdom=$1;
                   2943:         $krbdefdom=~tr/a-z/A-Z/;
                   2944:         $krbdef = "krb4";
                   2945:     }
                   2946:     return ($krbdef,$krbdefdom);
                   2947: }
1.112     bowersj2 2948: 
1.32      matthew  2949: 
1.46      matthew  2950: ###############################################################
                   2951: ##                Thesaurus Functions                        ##
                   2952: ###############################################################
1.20      www      2953: 
1.46      matthew  2954: =pod
1.20      www      2955: 
1.112     bowersj2 2956: =head1 Thesaurus Functions
                   2957: 
                   2958: =over 4
                   2959: 
1.648     raeburn  2960: =item * &initialize_keywords()
1.46      matthew  2961: 
                   2962: Initializes the package variable %Keywords if it is empty.  Uses the
                   2963: package variable $thesaurus_db_file.
                   2964: 
                   2965: =cut
                   2966: 
                   2967: ###################################################
                   2968: 
                   2969: sub initialize_keywords {
                   2970:     return 1 if (scalar keys(%Keywords));
                   2971:     # If we are here, %Keywords is empty, so fill it up
                   2972:     #   Make sure the file we need exists...
                   2973:     if (! -e $thesaurus_db_file) {
                   2974:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2975:                                  " failed because it does not exist");
                   2976:         return 0;
                   2977:     }
                   2978:     #   Set up the hash as a database
                   2979:     my %thesaurus_db;
                   2980:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2981:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2982:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2983:                                  $thesaurus_db_file);
                   2984:         return 0;
                   2985:     } 
                   2986:     #  Get the average number of appearances of a word.
                   2987:     my $avecount = $thesaurus_db{'average.count'};
                   2988:     #  Put keywords (those that appear > average) into %Keywords
                   2989:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2990:         my ($count,undef) = split /:/,$data;
                   2991:         $Keywords{$word}++ if ($count > $avecount);
                   2992:     }
                   2993:     untie %thesaurus_db;
                   2994:     # Remove special values from %Keywords.
1.356     albertel 2995:     foreach my $value ('total.count','average.count') {
                   2996:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2997:   }
1.46      matthew  2998:     return 1;
                   2999: }
                   3000: 
                   3001: ###################################################
                   3002: 
                   3003: =pod
                   3004: 
1.648     raeburn  3005: =item * &keyword($word)
1.46      matthew  3006: 
                   3007: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3008: than the average number of times in the thesaurus database.  Calls 
                   3009: &initialize_keywords
                   3010: 
                   3011: =cut
                   3012: 
                   3013: ###################################################
1.20      www      3014: 
                   3015: sub keyword {
1.46      matthew  3016:     return if (!&initialize_keywords());
                   3017:     my $word=lc(shift());
                   3018:     $word=~s/\W//g;
                   3019:     return exists($Keywords{$word});
1.20      www      3020: }
1.46      matthew  3021: 
                   3022: ###############################################################
                   3023: 
                   3024: =pod 
1.20      www      3025: 
1.648     raeburn  3026: =item * &get_related_words()
1.46      matthew  3027: 
1.160     matthew  3028: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3029: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3030: will be returned.  The order of the words returned is determined by the
                   3031: database which holds them.
                   3032: 
                   3033: Uses global $thesaurus_db_file.
                   3034: 
1.1057    foxr     3035: 
1.46      matthew  3036: =cut
                   3037: 
                   3038: ###############################################################
                   3039: sub get_related_words {
                   3040:     my $keyword = shift;
                   3041:     my %thesaurus_db;
                   3042:     if (! -e $thesaurus_db_file) {
                   3043:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3044:                                  "failed because the file does not exist");
                   3045:         return ();
                   3046:     }
                   3047:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3048:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3049:         return ();
                   3050:     } 
                   3051:     my @Words=();
1.429     www      3052:     my $count=0;
1.46      matthew  3053:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3054: 	# The first element is the number of times
                   3055: 	# the word appears.  We do not need it now.
1.429     www      3056: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3057: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3058: 	my $threshold=$mostfrequentcount/10;
                   3059:         foreach my $possibleword (@RelatedWords) {
                   3060:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3061:             if ($wordcount>$threshold) {
                   3062: 		push(@Words,$word);
                   3063:                 $count++;
                   3064:                 if ($count>10) { last; }
                   3065: 	    }
1.20      www      3066:         }
                   3067:     }
1.46      matthew  3068:     untie %thesaurus_db;
                   3069:     return @Words;
1.14      harris41 3070: }
1.1090    foxr     3071: ###############################################################
                   3072: #
                   3073: #  Spell checking
                   3074: #
                   3075: 
                   3076: =pod
                   3077: 
1.1142    raeburn  3078: =back
                   3079: 
1.1090    foxr     3080: =head1 Spell checking
                   3081: 
                   3082: =over 4
                   3083: 
                   3084: =item * &check_spelling($wordlist $language)
                   3085: 
                   3086: Takes a string containing words and feeds it to an external
                   3087: spellcheck program via a pipeline. Returns a string containing
                   3088: them mis-spelled words.
                   3089: 
                   3090: Parameters:
                   3091: 
                   3092: =over 4
                   3093: 
                   3094: =item - $wordlist
                   3095: 
                   3096: String that will be fed into the spellcheck program.
                   3097: 
                   3098: =item - $language
                   3099: 
                   3100: Language string that specifies the language for which the spell
                   3101: check will be performed.
                   3102: 
                   3103: =back
                   3104: 
                   3105: =back
                   3106: 
                   3107: Note: This sub assumes that aspell is installed.
                   3108: 
                   3109: 
                   3110: =cut
                   3111: 
1.46      matthew  3112: 
1.1090    foxr     3113: sub check_spelling {
                   3114:     my ($wordlist, $language) = @_;
1.1091    foxr     3115:     my @misspellings;
                   3116:     
                   3117:     # Generate the speller and set the langauge.
                   3118:     # if explicitly selected:
1.1090    foxr     3119: 
1.1091    foxr     3120:     my $speller = Text::Aspell->new;
1.1090    foxr     3121:     if ($language) {
1.1091    foxr     3122: 	$speller->set_option('lang', $language);
1.1090    foxr     3123:     }
                   3124: 
1.1091    foxr     3125:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     3126: 
1.1091    foxr     3127:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     3128: 
1.1091    foxr     3129:     foreach my $word (@words) {
                   3130: 	if(! $speller->check($word)) {
                   3131: 	    push(@misspellings, $word);
1.1090    foxr     3132: 	}
                   3133:     }
1.1091    foxr     3134:     return join(' ', @misspellings);
                   3135:     
1.1090    foxr     3136: }
                   3137: 
1.61      www      3138: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3139: =pod
                   3140: 
1.112     bowersj2 3141: =head1 User Name Functions
                   3142: 
                   3143: =over 4
                   3144: 
1.648     raeburn  3145: =item * &plainname($uname,$udom,$first)
1.81      albertel 3146: 
1.112     bowersj2 3147: Takes a users logon name and returns it as a string in
1.226     albertel 3148: "first middle last generation" form 
                   3149: if $first is set to 'lastname' then it returns it as
                   3150: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3151: 
                   3152: =cut
1.61      www      3153: 
1.295     www      3154: 
1.81      albertel 3155: ###############################################################
1.61      www      3156: sub plainname {
1.226     albertel 3157:     my ($uname,$udom,$first)=@_;
1.537     albertel 3158:     return if (!defined($uname) || !defined($udom));
1.295     www      3159:     my %names=&getnames($uname,$udom);
1.226     albertel 3160:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3161: 					  $names{'middlename'},
                   3162: 					  $names{'lastname'},
                   3163: 					  $names{'generation'},$first);
                   3164:     $name=~s/^\s+//;
1.62      www      3165:     $name=~s/\s+$//;
                   3166:     $name=~s/\s+/ /g;
1.353     albertel 3167:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3168:     return $name;
1.61      www      3169: }
1.66      www      3170: 
                   3171: # -------------------------------------------------------------------- Nickname
1.81      albertel 3172: =pod
                   3173: 
1.648     raeburn  3174: =item * &nickname($uname,$udom)
1.81      albertel 3175: 
                   3176: Gets a users name and returns it as a string as
                   3177: 
                   3178: "&quot;nickname&quot;"
1.66      www      3179: 
1.81      albertel 3180: if the user has a nickname or
                   3181: 
                   3182: "first middle last generation"
                   3183: 
                   3184: if the user does not
                   3185: 
                   3186: =cut
1.66      www      3187: 
                   3188: sub nickname {
                   3189:     my ($uname,$udom)=@_;
1.537     albertel 3190:     return if (!defined($uname) || !defined($udom));
1.295     www      3191:     my %names=&getnames($uname,$udom);
1.68      albertel 3192:     my $name=$names{'nickname'};
1.66      www      3193:     if ($name) {
                   3194:        $name='&quot;'.$name.'&quot;'; 
                   3195:     } else {
                   3196:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3197: 	     $names{'lastname'}.' '.$names{'generation'};
                   3198:        $name=~s/\s+$//;
                   3199:        $name=~s/\s+/ /g;
                   3200:     }
                   3201:     return $name;
                   3202: }
                   3203: 
1.295     www      3204: sub getnames {
                   3205:     my ($uname,$udom)=@_;
1.537     albertel 3206:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3207:     if ($udom eq 'public' && $uname eq 'public') {
                   3208: 	return ('lastname' => &mt('Public'));
                   3209:     }
1.295     www      3210:     my $id=$uname.':'.$udom;
                   3211:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3212:     if ($cached) {
                   3213: 	return %{$names};
                   3214:     } else {
                   3215: 	my %loadnames=&Apache::lonnet::get('environment',
                   3216:                     ['firstname','middlename','lastname','generation','nickname'],
                   3217: 					 $udom,$uname);
                   3218: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3219: 	return %loadnames;
                   3220:     }
                   3221: }
1.61      www      3222: 
1.542     raeburn  3223: # -------------------------------------------------------------------- getemails
1.648     raeburn  3224: 
1.542     raeburn  3225: =pod
                   3226: 
1.648     raeburn  3227: =item * &getemails($uname,$udom)
1.542     raeburn  3228: 
                   3229: Gets a user's email information and returns it as a hash with keys:
                   3230: notification, critnotification, permanentemail
                   3231: 
                   3232: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3233: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3234:  
1.648     raeburn  3235: 
1.542     raeburn  3236: =cut
                   3237: 
1.648     raeburn  3238: 
1.466     albertel 3239: sub getemails {
                   3240:     my ($uname,$udom)=@_;
                   3241:     if ($udom eq 'public' && $uname eq 'public') {
                   3242: 	return;
                   3243:     }
1.467     www      3244:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3245:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3246:     my $id=$uname.':'.$udom;
                   3247:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3248:     if ($cached) {
                   3249: 	return %{$names};
                   3250:     } else {
                   3251: 	my %loadnames=&Apache::lonnet::get('environment',
                   3252:                     			   ['notification','critnotification',
                   3253: 					    'permanentemail'],
                   3254: 					   $udom,$uname);
                   3255: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3256: 	return %loadnames;
                   3257:     }
                   3258: }
                   3259: 
1.551     albertel 3260: sub flush_email_cache {
                   3261:     my ($uname,$udom)=@_;
                   3262:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3263:     if (!$uname) { $uname=$env{'user.name'};   }
                   3264:     return if ($udom eq 'public' && $uname eq 'public');
                   3265:     my $id=$uname.':'.$udom;
                   3266:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3267: }
                   3268: 
1.728     raeburn  3269: # -------------------------------------------------------------------- getlangs
                   3270: 
                   3271: =pod
                   3272: 
                   3273: =item * &getlangs($uname,$udom)
                   3274: 
                   3275: Gets a user's language preference and returns it as a hash with key:
                   3276: language.
                   3277: 
                   3278: =cut
                   3279: 
                   3280: 
                   3281: sub getlangs {
                   3282:     my ($uname,$udom) = @_;
                   3283:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3284:     if (!$uname) { $uname=$env{'user.name'};   }
                   3285:     my $id=$uname.':'.$udom;
                   3286:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3287:     if ($cached) {
                   3288:         return %{$langs};
                   3289:     } else {
                   3290:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3291:                                            $udom,$uname);
                   3292:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3293:         return %loadlangs;
                   3294:     }
                   3295: }
                   3296: 
                   3297: sub flush_langs_cache {
                   3298:     my ($uname,$udom)=@_;
                   3299:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3300:     if (!$uname) { $uname=$env{'user.name'};   }
                   3301:     return if ($udom eq 'public' && $uname eq 'public');
                   3302:     my $id=$uname.':'.$udom;
                   3303:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3304: }
                   3305: 
1.61      www      3306: # ------------------------------------------------------------------ Screenname
1.81      albertel 3307: 
                   3308: =pod
                   3309: 
1.648     raeburn  3310: =item * &screenname($uname,$udom)
1.81      albertel 3311: 
                   3312: Gets a users screenname and returns it as a string
                   3313: 
                   3314: =cut
1.61      www      3315: 
                   3316: sub screenname {
                   3317:     my ($uname,$udom)=@_;
1.258     albertel 3318:     if ($uname eq $env{'user.name'} &&
                   3319: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3320:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3321:     return $names{'screenname'};
1.62      www      3322: }
                   3323: 
1.212     albertel 3324: 
1.802     bisitz   3325: # ------------------------------------------------------------- Confirm Wrapper
                   3326: =pod
                   3327: 
1.1142    raeburn  3328: =item * &confirmwrapper($message)
1.802     bisitz   3329: 
                   3330: Wrap messages about completion of operation in box
                   3331: 
                   3332: =cut
                   3333: 
                   3334: sub confirmwrapper {
                   3335:     my ($message)=@_;
                   3336:     if ($message) {
                   3337:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3338:                .$message."\n"
                   3339:                .'</div>'."\n";
                   3340:     } else {
                   3341:         return $message;
                   3342:     }
                   3343: }
                   3344: 
1.62      www      3345: # ------------------------------------------------------------- Message Wrapper
                   3346: 
                   3347: sub messagewrapper {
1.369     www      3348:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3349:     return 
1.441     albertel 3350:         '<a href="/adm/email?compose=individual&amp;'.
                   3351:         'recname='.$username.'&amp;recdom='.$domain.
                   3352: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3353:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3354: }
1.802     bisitz   3355: 
1.74      www      3356: # --------------------------------------------------------------- Notes Wrapper
                   3357: 
                   3358: sub noteswrapper {
                   3359:     my ($link,$un,$do)=@_;
                   3360:     return 
1.896     amueller 3361: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3362: }
1.802     bisitz   3363: 
1.62      www      3364: # ------------------------------------------------------------- Aboutme Wrapper
                   3365: 
                   3366: sub aboutmewrapper {
1.1070    raeburn  3367:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3368:     if (!defined($username)  && !defined($domain)) {
                   3369:         return;
                   3370:     }
1.1096    raeburn  3371:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3372: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3373: }
                   3374: 
                   3375: # ------------------------------------------------------------ Syllabus Wrapper
                   3376: 
                   3377: sub syllabuswrapper {
1.707     bisitz   3378:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3379:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3380: }
1.14      harris41 3381: 
1.802     bisitz   3382: # -----------------------------------------------------------------------------
                   3383: 
1.208     matthew  3384: sub track_student_link {
1.887     raeburn  3385:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3386:     my $link ="/adm/trackstudent?";
1.208     matthew  3387:     my $title = 'View recent activity';
                   3388:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3389:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3390:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3391:         $title .= ' of this student';
1.268     albertel 3392:     } 
1.208     matthew  3393:     if (defined($target) && $target !~ /^\s*$/) {
                   3394:         $target = qq{target="$target"};
                   3395:     } else {
                   3396:         $target = '';
                   3397:     }
1.268     albertel 3398:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3399:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3400:     $title = &mt($title);
                   3401:     $linktext = &mt($linktext);
1.448     albertel 3402:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3403: 	&help_open_topic('View_recent_activity');
1.208     matthew  3404: }
                   3405: 
1.781     raeburn  3406: sub slot_reservations_link {
                   3407:     my ($linktext,$sname,$sdom,$target) = @_;
                   3408:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3409:     my $title = 'View slot reservation history';
                   3410:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3411:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3412:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3413:         $title .= ' of this student';
                   3414:     }
                   3415:     if (defined($target) && $target !~ /^\s*$/) {
                   3416:         $target = qq{target="$target"};
                   3417:     } else {
                   3418:         $target = '';
                   3419:     }
                   3420:     $title = &mt($title);
                   3421:     $linktext = &mt($linktext);
                   3422:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3423: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3424: 
                   3425: }
                   3426: 
1.508     www      3427: # ===================================================== Display a student photo
                   3428: 
                   3429: 
1.509     albertel 3430: sub student_image_tag {
1.508     www      3431:     my ($domain,$user)=@_;
                   3432:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3433:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3434: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3435:     } else {
                   3436: 	return '';
                   3437:     }
                   3438: }
                   3439: 
1.112     bowersj2 3440: =pod
                   3441: 
                   3442: =back
                   3443: 
                   3444: =head1 Access .tab File Data
                   3445: 
                   3446: =over 4
                   3447: 
1.648     raeburn  3448: =item * &languageids() 
1.112     bowersj2 3449: 
                   3450: returns list of all language ids
                   3451: 
                   3452: =cut
                   3453: 
1.14      harris41 3454: sub languageids {
1.16      harris41 3455:     return sort(keys(%language));
1.14      harris41 3456: }
                   3457: 
1.112     bowersj2 3458: =pod
                   3459: 
1.648     raeburn  3460: =item * &languagedescription() 
1.112     bowersj2 3461: 
                   3462: returns description of a specified language id
                   3463: 
                   3464: =cut
                   3465: 
1.14      harris41 3466: sub languagedescription {
1.125     www      3467:     my $code=shift;
                   3468:     return  ($supported_language{$code}?'* ':'').
                   3469:             $language{$code}.
1.126     www      3470: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3471: }
                   3472: 
1.1048    foxr     3473: =pod
                   3474: 
                   3475: =item * &plainlanguagedescription
                   3476: 
                   3477: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3478: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3479: 
                   3480: =cut
                   3481: 
1.145     www      3482: sub plainlanguagedescription {
                   3483:     my $code=shift;
                   3484:     return $language{$code};
                   3485: }
                   3486: 
1.1048    foxr     3487: =pod
                   3488: 
                   3489: =item * &supportedlanguagecode
                   3490: 
                   3491: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3492: code.
                   3493: 
                   3494: =cut
                   3495: 
1.145     www      3496: sub supportedlanguagecode {
                   3497:     my $code=shift;
                   3498:     return $supported_language{$code};
1.97      www      3499: }
                   3500: 
1.112     bowersj2 3501: =pod
                   3502: 
1.1048    foxr     3503: =item * &latexlanguage()
                   3504: 
                   3505: Given a language key code returns the correspondnig language to use
                   3506: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3507: is no supported hyphenation for the language code.
                   3508: 
                   3509: =cut
                   3510: 
                   3511: sub latexlanguage {
                   3512:     my $code = shift;
                   3513:     return $latex_language{$code};
                   3514: }
                   3515: 
                   3516: =pod
                   3517: 
                   3518: =item * &latexhyphenation()
                   3519: 
                   3520: Same as above but what's supplied is the language as it might be stored
                   3521: in the metadata.
                   3522: 
                   3523: =cut
                   3524: 
                   3525: sub latexhyphenation {
                   3526:     my $key = shift;
                   3527:     return $latex_language_bykey{$key};
                   3528: }
                   3529: 
                   3530: =pod
                   3531: 
1.648     raeburn  3532: =item * &copyrightids() 
1.112     bowersj2 3533: 
                   3534: returns list of all copyrights
                   3535: 
                   3536: =cut
                   3537: 
                   3538: sub copyrightids {
                   3539:     return sort(keys(%cprtag));
                   3540: }
                   3541: 
                   3542: =pod
                   3543: 
1.648     raeburn  3544: =item * &copyrightdescription() 
1.112     bowersj2 3545: 
                   3546: returns description of a specified copyright id
                   3547: 
                   3548: =cut
                   3549: 
                   3550: sub copyrightdescription {
1.166     www      3551:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3552: }
1.197     matthew  3553: 
                   3554: =pod
                   3555: 
1.648     raeburn  3556: =item * &source_copyrightids() 
1.192     taceyjo1 3557: 
                   3558: returns list of all source copyrights
                   3559: 
                   3560: =cut
                   3561: 
                   3562: sub source_copyrightids {
                   3563:     return sort(keys(%scprtag));
                   3564: }
                   3565: 
                   3566: =pod
                   3567: 
1.648     raeburn  3568: =item * &source_copyrightdescription() 
1.192     taceyjo1 3569: 
                   3570: returns description of a specified source copyright id
                   3571: 
                   3572: =cut
                   3573: 
                   3574: sub source_copyrightdescription {
                   3575:     return &mt($scprtag{shift(@_)});
                   3576: }
1.112     bowersj2 3577: 
                   3578: =pod
                   3579: 
1.648     raeburn  3580: =item * &filecategories() 
1.112     bowersj2 3581: 
                   3582: returns list of all file categories
                   3583: 
                   3584: =cut
                   3585: 
                   3586: sub filecategories {
                   3587:     return sort(keys(%category_extensions));
                   3588: }
                   3589: 
                   3590: =pod
                   3591: 
1.648     raeburn  3592: =item * &filecategorytypes() 
1.112     bowersj2 3593: 
                   3594: returns list of file types belonging to a given file
                   3595: category
                   3596: 
                   3597: =cut
                   3598: 
                   3599: sub filecategorytypes {
1.356     albertel 3600:     my ($cat) = @_;
                   3601:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3602: }
                   3603: 
                   3604: =pod
                   3605: 
1.648     raeburn  3606: =item * &fileembstyle() 
1.112     bowersj2 3607: 
                   3608: returns embedding style for a specified file type
                   3609: 
                   3610: =cut
                   3611: 
                   3612: sub fileembstyle {
                   3613:     return $fe{lc(shift(@_))};
1.169     www      3614: }
                   3615: 
1.351     www      3616: sub filemimetype {
                   3617:     return $fm{lc(shift(@_))};
                   3618: }
                   3619: 
1.169     www      3620: 
                   3621: sub filecategoryselect {
                   3622:     my ($name,$value)=@_;
1.189     matthew  3623:     return &select_form($value,$name,
1.970     raeburn  3624:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3625: }
                   3626: 
                   3627: =pod
                   3628: 
1.648     raeburn  3629: =item * &filedescription() 
1.112     bowersj2 3630: 
                   3631: returns description for a specified file type
                   3632: 
                   3633: =cut
                   3634: 
                   3635: sub filedescription {
1.188     matthew  3636:     my $file_description = $fd{lc(shift())};
                   3637:     $file_description =~ s:([\[\]]):~$1:g;
                   3638:     return &mt($file_description);
1.112     bowersj2 3639: }
                   3640: 
                   3641: =pod
                   3642: 
1.648     raeburn  3643: =item * &filedescriptionex() 
1.112     bowersj2 3644: 
                   3645: returns description for a specified file type with
                   3646: extra formatting
                   3647: 
                   3648: =cut
                   3649: 
                   3650: sub filedescriptionex {
                   3651:     my $ex=shift;
1.188     matthew  3652:     my $file_description = $fd{lc($ex)};
                   3653:     $file_description =~ s:([\[\]]):~$1:g;
                   3654:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3655: }
                   3656: 
                   3657: # End of .tab access
                   3658: =pod
                   3659: 
                   3660: =back
                   3661: 
                   3662: =cut
                   3663: 
                   3664: # ------------------------------------------------------------------ File Types
                   3665: sub fileextensions {
                   3666:     return sort(keys(%fe));
                   3667: }
                   3668: 
1.97      www      3669: # ----------------------------------------------------------- Display Languages
                   3670: # returns a hash with all desired display languages
                   3671: #
                   3672: 
                   3673: sub display_languages {
                   3674:     my %languages=();
1.695     raeburn  3675:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3676: 	$languages{$lang}=1;
1.97      www      3677:     }
                   3678:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3679:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3680: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3681: 	    $languages{$lang}=1;
1.97      www      3682:         }
                   3683:     }
                   3684:     return %languages;
1.14      harris41 3685: }
                   3686: 
1.582     albertel 3687: sub languages {
                   3688:     my ($possible_langs) = @_;
1.695     raeburn  3689:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3690:     if (!ref($possible_langs)) {
                   3691: 	if( wantarray ) {
                   3692: 	    return @preferred_langs;
                   3693: 	} else {
                   3694: 	    return $preferred_langs[0];
                   3695: 	}
                   3696:     }
                   3697:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3698:     my @preferred_possibilities;
                   3699:     foreach my $preferred_lang (@preferred_langs) {
                   3700: 	if (exists($possibilities{$preferred_lang})) {
                   3701: 	    push(@preferred_possibilities, $preferred_lang);
                   3702: 	}
                   3703:     }
                   3704:     if( wantarray ) {
                   3705: 	return @preferred_possibilities;
                   3706:     }
                   3707:     return $preferred_possibilities[0];
                   3708: }
                   3709: 
1.742     raeburn  3710: sub user_lang {
                   3711:     my ($touname,$toudom,$fromcid) = @_;
                   3712:     my @userlangs;
                   3713:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3714:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3715:                     $env{'course.'.$fromcid.'.languages'}));
                   3716:     } else {
                   3717:         my %langhash = &getlangs($touname,$toudom);
                   3718:         if ($langhash{'languages'} ne '') {
                   3719:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3720:         } else {
                   3721:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3722:             if ($domdefs{'lang_def'} ne '') {
                   3723:                 @userlangs = ($domdefs{'lang_def'});
                   3724:             }
                   3725:         }
                   3726:     }
                   3727:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3728:     my $user_lh = Apache::localize->get_handle(@languages);
                   3729:     return $user_lh;
                   3730: }
                   3731: 
                   3732: 
1.112     bowersj2 3733: ###############################################################
                   3734: ##               Student Answer Attempts                     ##
                   3735: ###############################################################
                   3736: 
                   3737: =pod
                   3738: 
                   3739: =head1 Alternate Problem Views
                   3740: 
                   3741: =over 4
                   3742: 
1.648     raeburn  3743: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3744:     $getattempt, $regexp, $gradesub)
                   3745: 
                   3746: Return string with previous attempt on problem. Arguments:
                   3747: 
                   3748: =over 4
                   3749: 
                   3750: =item * $symb: Problem, including path
                   3751: 
                   3752: =item * $username: username of the desired student
                   3753: 
                   3754: =item * $domain: domain of the desired student
1.14      harris41 3755: 
1.112     bowersj2 3756: =item * $course: Course ID
1.14      harris41 3757: 
1.112     bowersj2 3758: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3759:     something
1.14      harris41 3760: 
1.112     bowersj2 3761: =item * $regexp: if string matches this regexp, the string will be
                   3762:     sent to $gradesub
1.14      harris41 3763: 
1.112     bowersj2 3764: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3765: 
1.112     bowersj2 3766: =back
1.14      harris41 3767: 
1.112     bowersj2 3768: The output string is a table containing all desired attempts, if any.
1.16      harris41 3769: 
1.112     bowersj2 3770: =cut
1.1       albertel 3771: 
                   3772: sub get_previous_attempt {
1.43      ng       3773:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3774:   my $prevattempts='';
1.43      ng       3775:   no strict 'refs';
1.1       albertel 3776:   if ($symb) {
1.3       albertel 3777:     my (%returnhash)=
                   3778:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3779:     if ($returnhash{'version'}) {
                   3780:       my %lasthash=();
                   3781:       my $version;
                   3782:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3783:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3784: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3785:         }
1.1       albertel 3786:       }
1.596     albertel 3787:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3788:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3789:       my (%typeparts,%lasthidden);
1.945     raeburn  3790:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3791:       foreach my $key (sort(keys(%lasthash))) {
                   3792: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3793: 	if ($#parts > 0) {
1.31      albertel 3794: 	  my $data=$parts[-1];
1.989     raeburn  3795:           next if ($data eq 'foilorder');
1.31      albertel 3796: 	  pop(@parts);
1.1010    www      3797:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3798:           if ($data eq 'type') {
                   3799:               unless ($showsurv) {
                   3800:                   my $id = join(',',@parts);
                   3801:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3802:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3803:                       $lasthidden{$ign.'.'.$id} = 1;
                   3804:                   }
1.945     raeburn  3805:               }
1.1010    www      3806:           } 
1.31      albertel 3807: 	} else {
1.41      ng       3808: 	  if ($#parts == 0) {
                   3809: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3810: 	  } else {
                   3811: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3812: 	  }
1.31      albertel 3813: 	}
1.16      harris41 3814:       }
1.596     albertel 3815:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3816:       if ($getattempt eq '') {
                   3817: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3818:             my @hidden;
                   3819:             if (%typeparts) {
                   3820:                 foreach my $id (keys(%typeparts)) {
                   3821:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3822:                         push(@hidden,$id);
                   3823:                     }
                   3824:                 }
                   3825:             }
                   3826:             $prevattempts.=&start_data_table_row().
                   3827:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3828:             if (@hidden) {
                   3829:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3830:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3831:                     my $hide;
                   3832:                     foreach my $id (@hidden) {
                   3833:                         if ($key =~ /^\Q$id\E/) {
                   3834:                             $hide = 1;
                   3835:                             last;
                   3836:                         }
                   3837:                     }
                   3838:                     if ($hide) {
                   3839:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3840:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3841:                             my $value = &format_previous_attempt_value($key,
                   3842:                                              $returnhash{$version.':'.$key});
                   3843:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3844:                         } else {
                   3845:                             $prevattempts.='<td>&nbsp;</td>';
                   3846:                         }
                   3847:                     } else {
                   3848:                         if ($key =~ /\./) {
                   3849:                             my $value = &format_previous_attempt_value($key,
                   3850:                                               $returnhash{$version.':'.$key});
                   3851:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3852:                         } else {
                   3853:                             $prevattempts.='<td>&nbsp;</td>';
                   3854:                         }
                   3855:                     }
                   3856:                 }
                   3857:             } else {
                   3858: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3859:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3860: 		    my $value = &format_previous_attempt_value($key,
                   3861: 			            $returnhash{$version.':'.$key});
                   3862: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3863: 	        }
                   3864:             }
                   3865: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3866: 	 }
1.1       albertel 3867:       }
1.945     raeburn  3868:       my @currhidden = keys(%lasthidden);
1.596     albertel 3869:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3870:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3871:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3872:           if (%typeparts) {
                   3873:               my $hidden;
                   3874:               foreach my $id (@currhidden) {
                   3875:                   if ($key =~ /^\Q$id\E/) {
                   3876:                       $hidden = 1;
                   3877:                       last;
                   3878:                   }
                   3879:               }
                   3880:               if ($hidden) {
                   3881:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3882:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3883:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3884:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3885:                           $value = &$gradesub($value);
                   3886:                       }
                   3887:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3888:                   } else {
                   3889:                       $prevattempts.='<td>&nbsp;</td>';
                   3890:                   }
                   3891:               } else {
                   3892:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3893:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3894:                       $value = &$gradesub($value);
                   3895:                   }
                   3896:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3897:               }
                   3898:           } else {
                   3899: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3900: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3901:                   $value = &$gradesub($value);
                   3902:               }
                   3903: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3904:           }
1.16      harris41 3905:       }
1.596     albertel 3906:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3907:     } else {
1.596     albertel 3908:       $prevattempts=
                   3909: 	  &start_data_table().&start_data_table_row().
                   3910: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3911: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3912:     }
                   3913:   } else {
1.596     albertel 3914:     $prevattempts=
                   3915: 	  &start_data_table().&start_data_table_row().
                   3916: 	  '<td>'.&mt('No data.').'</td>'.
                   3917: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3918:   }
1.10      albertel 3919: }
                   3920: 
1.581     albertel 3921: sub format_previous_attempt_value {
                   3922:     my ($key,$value) = @_;
1.1011    www      3923:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3924: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3925:     } elsif (ref($value) eq 'ARRAY') {
                   3926: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3927:     } elsif ($key =~ /answerstring$/) {
                   3928:         my %answers = &Apache::lonnet::str2hash($value);
                   3929:         my @anskeys = sort(keys(%answers));
                   3930:         if (@anskeys == 1) {
                   3931:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3932:             if ($answer =~ m{\0}) {
                   3933:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3934:             }
                   3935:             my $tag_internal_answer_name = 'INTERNAL';
                   3936:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3937:                 $value = $answer; 
                   3938:             } else {
                   3939:                 $value = $anskeys[0].'='.$answer;
                   3940:             }
                   3941:         } else {
                   3942:             foreach my $ans (@anskeys) {
                   3943:                 my $answer = $answers{$ans};
1.1001    raeburn  3944:                 if ($answer =~ m{\0}) {
                   3945:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3946:                 }
                   3947:                 $value .=  $ans.'='.$answer.'<br />';;
                   3948:             } 
                   3949:         }
1.581     albertel 3950:     } else {
                   3951: 	$value = &unescape($value);
                   3952:     }
                   3953:     return $value;
                   3954: }
                   3955: 
                   3956: 
1.107     albertel 3957: sub relative_to_absolute {
                   3958:     my ($url,$output)=@_;
                   3959:     my $parser=HTML::TokeParser->new(\$output);
                   3960:     my $token;
                   3961:     my $thisdir=$url;
                   3962:     my @rlinks=();
                   3963:     while ($token=$parser->get_token) {
                   3964: 	if ($token->[0] eq 'S') {
                   3965: 	    if ($token->[1] eq 'a') {
                   3966: 		if ($token->[2]->{'href'}) {
                   3967: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3968: 		}
                   3969: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3970: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3971: 	    } elsif ($token->[1] eq 'base') {
                   3972: 		$thisdir=$token->[2]->{'href'};
                   3973: 	    }
                   3974: 	}
                   3975:     }
                   3976:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3977:     foreach my $link (@rlinks) {
1.726     raeburn  3978: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3979: 		($link=~/^\//) ||
                   3980: 		($link=~/^javascript:/i) ||
                   3981: 		($link=~/^mailto:/i) ||
                   3982: 		($link=~/^\#/)) {
                   3983: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3984: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3985: 	}
                   3986:     }
                   3987: # -------------------------------------------------- Deal with Applet codebases
                   3988:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3989:     return $output;
                   3990: }
                   3991: 
1.112     bowersj2 3992: =pod
                   3993: 
1.648     raeburn  3994: =item * &get_student_view()
1.112     bowersj2 3995: 
                   3996: show a snapshot of what student was looking at
                   3997: 
                   3998: =cut
                   3999: 
1.10      albertel 4000: sub get_student_view {
1.186     albertel 4001:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4002:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4003:   my (%form);
1.10      albertel 4004:   my @elements=('symb','courseid','domain','username');
                   4005:   foreach my $element (@elements) {
1.186     albertel 4006:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4007:   }
1.186     albertel 4008:   if (defined($moreenv)) {
                   4009:       %form=(%form,%{$moreenv});
                   4010:   }
1.236     albertel 4011:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4012:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4013:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4014:   $userview=~s/\<body[^\>]*\>//gi;
                   4015:   $userview=~s/\<\/body\>//gi;
                   4016:   $userview=~s/\<html\>//gi;
                   4017:   $userview=~s/\<\/html\>//gi;
                   4018:   $userview=~s/\<head\>//gi;
                   4019:   $userview=~s/\<\/head\>//gi;
                   4020:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4021:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4022:   if (wantarray) {
                   4023:      return ($userview,$response);
                   4024:   } else {
                   4025:      return $userview;
                   4026:   }
                   4027: }
                   4028: 
                   4029: sub get_student_view_with_retries {
                   4030:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4031: 
                   4032:     my $ok = 0;                 # True if we got a good response.
                   4033:     my $content;
                   4034:     my $response;
                   4035: 
                   4036:     # Try to get the student_view done. within the retries count:
                   4037:     
                   4038:     do {
                   4039:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4040:          $ok      = $response->is_success;
                   4041:          if (!$ok) {
                   4042:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4043:          }
                   4044:          $retries--;
                   4045:     } while (!$ok && ($retries > 0));
                   4046:     
                   4047:     if (!$ok) {
                   4048:        $content = '';          # On error return an empty content.
                   4049:     }
1.651     www      4050:     if (wantarray) {
                   4051:        return ($content, $response);
                   4052:     } else {
                   4053:        return $content;
                   4054:     }
1.11      albertel 4055: }
                   4056: 
1.112     bowersj2 4057: =pod
                   4058: 
1.648     raeburn  4059: =item * &get_student_answers() 
1.112     bowersj2 4060: 
                   4061: show a snapshot of how student was answering problem
                   4062: 
                   4063: =cut
                   4064: 
1.11      albertel 4065: sub get_student_answers {
1.100     sakharuk 4066:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4067:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4068:   my (%moreenv);
1.11      albertel 4069:   my @elements=('symb','courseid','domain','username');
                   4070:   foreach my $element (@elements) {
1.186     albertel 4071:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4072:   }
1.186     albertel 4073:   $moreenv{'grade_target'}='answer';
                   4074:   %moreenv=(%form,%moreenv);
1.497     raeburn  4075:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4076:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4077:   return $userview;
1.1       albertel 4078: }
1.116     albertel 4079: 
                   4080: =pod
                   4081: 
                   4082: =item * &submlink()
                   4083: 
1.242     albertel 4084: Inputs: $text $uname $udom $symb $target
1.116     albertel 4085: 
                   4086: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4087: 
                   4088: =cut
                   4089: 
                   4090: ###############################################
                   4091: sub submlink {
1.242     albertel 4092:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4093:     if (!($uname && $udom)) {
                   4094: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4095: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4096: 	if (!$symb) { $symb=$cursymb; }
                   4097:     }
1.254     matthew  4098:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4099:     $symb=&escape($symb);
1.960     bisitz   4100:     if ($target) { $target=" target=\"$target\""; }
                   4101:     return
                   4102:         '<a href="/adm/grades?command=submission'.
                   4103:         '&amp;symb='.$symb.
                   4104:         '&amp;student='.$uname.
                   4105:         '&amp;userdom='.$udom.'"'.
                   4106:         $target.'>'.$text.'</a>';
1.242     albertel 4107: }
                   4108: ##############################################
                   4109: 
                   4110: =pod
                   4111: 
                   4112: =item * &pgrdlink()
                   4113: 
                   4114: Inputs: $text $uname $udom $symb $target
                   4115: 
                   4116: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4117: 
                   4118: =cut
                   4119: 
                   4120: ###############################################
                   4121: sub pgrdlink {
                   4122:     my $link=&submlink(@_);
                   4123:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4124:     return $link;
                   4125: }
                   4126: ##############################################
                   4127: 
                   4128: =pod
                   4129: 
                   4130: =item * &pprmlink()
                   4131: 
                   4132: Inputs: $text $uname $udom $symb $target
                   4133: 
                   4134: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4135: student and a specific resource
1.242     albertel 4136: 
                   4137: =cut
                   4138: 
                   4139: ###############################################
                   4140: sub pprmlink {
                   4141:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4142:     if (!($uname && $udom)) {
                   4143: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4144: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4145: 	if (!$symb) { $symb=$cursymb; }
                   4146:     }
1.254     matthew  4147:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4148:     $symb=&escape($symb);
1.242     albertel 4149:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4150:     return '<a href="/adm/parmset?command=set&amp;'.
                   4151: 	'symb='.$symb.'&amp;uname='.$uname.
                   4152: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4153: }
                   4154: ##############################################
1.37      matthew  4155: 
1.112     bowersj2 4156: =pod
                   4157: 
                   4158: =back
                   4159: 
                   4160: =cut
                   4161: 
1.37      matthew  4162: ###############################################
1.51      www      4163: 
                   4164: 
                   4165: sub timehash {
1.687     raeburn  4166:     my ($thistime) = @_;
                   4167:     my $timezone = &Apache::lonlocal::gettimezone();
                   4168:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4169:                      ->set_time_zone($timezone);
                   4170:     my $wday = $dt->day_of_week();
                   4171:     if ($wday == 7) { $wday = 0; }
                   4172:     return ( 'second' => $dt->second(),
                   4173:              'minute' => $dt->minute(),
                   4174:              'hour'   => $dt->hour(),
                   4175:              'day'     => $dt->day_of_month(),
                   4176:              'month'   => $dt->month(),
                   4177:              'year'    => $dt->year(),
                   4178:              'weekday' => $wday,
                   4179:              'dayyear' => $dt->day_of_year(),
                   4180:              'dlsav'   => $dt->is_dst() );
1.51      www      4181: }
                   4182: 
1.370     www      4183: sub utc_string {
                   4184:     my ($date)=@_;
1.371     www      4185:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4186: }
                   4187: 
1.51      www      4188: sub maketime {
                   4189:     my %th=@_;
1.687     raeburn  4190:     my ($epoch_time,$timezone,$dt);
                   4191:     $timezone = &Apache::lonlocal::gettimezone();
                   4192:     eval {
                   4193:         $dt = DateTime->new( year   => $th{'year'},
                   4194:                              month  => $th{'month'},
                   4195:                              day    => $th{'day'},
                   4196:                              hour   => $th{'hour'},
                   4197:                              minute => $th{'minute'},
                   4198:                              second => $th{'second'},
                   4199:                              time_zone => $timezone,
                   4200:                          );
                   4201:     };
                   4202:     if (!$@) {
                   4203:         $epoch_time = $dt->epoch;
                   4204:         if ($epoch_time) {
                   4205:             return $epoch_time;
                   4206:         }
                   4207:     }
1.51      www      4208:     return POSIX::mktime(
                   4209:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4210:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4211: }
                   4212: 
                   4213: #########################################
1.51      www      4214: 
                   4215: sub findallcourses {
1.482     raeburn  4216:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4217:     my %roles;
                   4218:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4219:     my %courses;
1.51      www      4220:     my $now=time;
1.482     raeburn  4221:     if (!defined($uname)) {
                   4222:         $uname = $env{'user.name'};
                   4223:     }
                   4224:     if (!defined($udom)) {
                   4225:         $udom = $env{'user.domain'};
                   4226:     }
                   4227:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4228:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4229:         if (!%roles) {
                   4230:             %roles = (
                   4231:                        cc => 1,
1.907     raeburn  4232:                        co => 1,
1.482     raeburn  4233:                        in => 1,
                   4234:                        ep => 1,
                   4235:                        ta => 1,
                   4236:                        cr => 1,
                   4237:                        st => 1,
                   4238:              );
                   4239:         }
                   4240:         foreach my $entry (keys(%roleshash)) {
                   4241:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4242:             if ($trole =~ /^cr/) { 
                   4243:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4244:             } else {
                   4245:                 next if (!exists($roles{$trole}));
                   4246:             }
                   4247:             if ($tend) {
                   4248:                 next if ($tend < $now);
                   4249:             }
                   4250:             if ($tstart) {
                   4251:                 next if ($tstart > $now);
                   4252:             }
1.1058    raeburn  4253:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4254:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4255:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4256:             if ($secpart eq '') {
                   4257:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4258:                 $sec = 'none';
1.1058    raeburn  4259:                 $value .= $cnum.'/';
1.482     raeburn  4260:             } else {
                   4261:                 $cnum = $cnumpart;
                   4262:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4263:                 $value .= $cnum.'/'.$sec;
                   4264:             }
                   4265:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4266:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4267:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4268:                 }
                   4269:             } else {
                   4270:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4271:             }
1.482     raeburn  4272:         }
                   4273:     } else {
                   4274:         foreach my $key (keys(%env)) {
1.483     albertel 4275: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4276:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4277: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4278: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4279: 	        next if (%roles && !exists($roles{$role}));
                   4280: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4281:                 my $active=1;
                   4282:                 if ($starttime) {
                   4283: 		    if ($now<$starttime) { $active=0; }
                   4284:                 }
                   4285:                 if ($endtime) {
                   4286:                     if ($now>$endtime) { $active=0; }
                   4287:                 }
                   4288:                 if ($active) {
1.1058    raeburn  4289:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4290:                     if ($sec eq '') {
                   4291:                         $sec = 'none';
1.1058    raeburn  4292:                     } else {
                   4293:                         $value .= $sec;
                   4294:                     }
                   4295:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4296:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4297:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4298:                         }
                   4299:                     } else {
                   4300:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4301:                     }
1.474     raeburn  4302:                 }
                   4303:             }
1.51      www      4304:         }
                   4305:     }
1.474     raeburn  4306:     return %courses;
1.51      www      4307: }
1.37      matthew  4308: 
1.54      www      4309: ###############################################
1.474     raeburn  4310: 
                   4311: sub blockcheck {
1.1062    raeburn  4312:     my ($setters,$activity,$uname,$udom,$url) = @_;
1.490     raeburn  4313: 
                   4314:     if (!defined($udom)) {
                   4315:         $udom = $env{'user.domain'};
                   4316:     }
                   4317:     if (!defined($uname)) {
                   4318:         $uname = $env{'user.name'};
                   4319:     }
                   4320: 
                   4321:     # If uname and udom are for a course, check for blocks in the course.
                   4322: 
                   4323:     if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062    raeburn  4324:         my ($startblock,$endblock,$triggerblock) = 
                   4325:             &get_blocks($setters,$activity,$udom,$uname,$url);
                   4326:         return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4327:     }
1.474     raeburn  4328: 
1.502     raeburn  4329:     my $startblock = 0;
                   4330:     my $endblock = 0;
1.1062    raeburn  4331:     my $triggerblock = '';
1.482     raeburn  4332:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4333: 
1.490     raeburn  4334:     # If uname is for a user, and activity is course-specific, i.e.,
                   4335:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4336: 
1.490     raeburn  4337:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4338:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4339:         foreach my $key (keys(%live_courses)) {
                   4340:             if ($key ne $env{'request.course.id'}) {
                   4341:                 delete($live_courses{$key});
                   4342:             }
                   4343:         }
                   4344:     }
                   4345: 
                   4346:     my $otheruser = 0;
                   4347:     my %own_courses;
                   4348:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4349:         # Resource belongs to user other than current user.
                   4350:         $otheruser = 1;
                   4351:         # Gather courses for current user
                   4352:         %own_courses = 
                   4353:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4354:     }
                   4355: 
                   4356:     # Gather active course roles - course coordinator, instructor, 
                   4357:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4358: 
                   4359:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4360:         my ($cdom,$cnum);
                   4361:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4362:             $cdom = $env{'course.'.$course.'.domain'};
                   4363:             $cnum = $env{'course.'.$course.'.num'};
                   4364:         } else {
1.490     raeburn  4365:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4366:         }
                   4367:         my $no_ownblock = 0;
                   4368:         my $no_userblock = 0;
1.533     raeburn  4369:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4370:             # Check if current user has 'evb' priv for this
                   4371:             if (defined($own_courses{$course})) {
                   4372:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4373:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4374:                     if ($sec ne 'none') {
                   4375:                         $checkrole .= '/'.$sec;
                   4376:                     }
                   4377:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4378:                         $no_ownblock = 1;
                   4379:                         last;
                   4380:                     }
                   4381:                 }
                   4382:             }
                   4383:             # if they have 'evb' priv and are currently not playing student
                   4384:             next if (($no_ownblock) &&
                   4385:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4386:         }
1.474     raeburn  4387:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4388:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4389:             if ($sec ne 'none') {
1.482     raeburn  4390:                 $checkrole .= '/'.$sec;
1.474     raeburn  4391:             }
1.490     raeburn  4392:             if ($otheruser) {
                   4393:                 # Resource belongs to user other than current user.
                   4394:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4395:                 my (%allroles,%userroles);
                   4396:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4397:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4398:                         my ($trole,$tdom,$tnum,$tsec);
                   4399:                         if ($entry =~ /^cr/) {
                   4400:                             ($trole,$tdom,$tnum,$tsec) = 
                   4401:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4402:                         } else {
                   4403:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4404:                         }
                   4405:                         my ($spec,$area,$trest);
                   4406:                         $area = '/'.$tdom.'/'.$tnum;
                   4407:                         $trest = $tnum;
                   4408:                         if ($tsec ne '') {
                   4409:                             $area .= '/'.$tsec;
                   4410:                             $trest .= '/'.$tsec;
                   4411:                         }
                   4412:                         $spec = $trole.'.'.$area;
                   4413:                         if ($trole =~ /^cr/) {
                   4414:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4415:                                                               $tdom,$spec,$trest,$area);
                   4416:                         } else {
                   4417:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4418:                                                                 $tdom,$spec,$trest,$area);
                   4419:                         }
                   4420:                     }
                   4421:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4422:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4423:                         if ($1) {
                   4424:                             $no_userblock = 1;
                   4425:                             last;
                   4426:                         }
1.486     raeburn  4427:                     }
                   4428:                 }
1.490     raeburn  4429:             } else {
                   4430:                 # Resource belongs to current user
                   4431:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4432:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4433:                     $no_ownblock = 1;
                   4434:                     last;
                   4435:                 }
1.474     raeburn  4436:             }
                   4437:         }
                   4438:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4439:         next if (($no_ownblock) &&
1.491     albertel 4440:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4441:         next if ($no_userblock);
1.474     raeburn  4442: 
1.866     kalberla 4443:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4444:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4445:         
1.1062    raeburn  4446:         my ($start,$end,$trigger) = 
                   4447:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4448:         if (($start != 0) && 
                   4449:             (($startblock == 0) || ($startblock > $start))) {
                   4450:             $startblock = $start;
1.1062    raeburn  4451:             if ($trigger ne '') {
                   4452:                 $triggerblock = $trigger;
                   4453:             }
1.502     raeburn  4454:         }
                   4455:         if (($end != 0)  &&
                   4456:             (($endblock == 0) || ($endblock < $end))) {
                   4457:             $endblock = $end;
1.1062    raeburn  4458:             if ($trigger ne '') {
                   4459:                 $triggerblock = $trigger;
                   4460:             }
1.502     raeburn  4461:         }
1.490     raeburn  4462:     }
1.1062    raeburn  4463:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4464: }
                   4465: 
                   4466: sub get_blocks {
1.1062    raeburn  4467:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4468:     my $startblock = 0;
                   4469:     my $endblock = 0;
1.1062    raeburn  4470:     my $triggerblock = '';
1.490     raeburn  4471:     my $course = $cdom.'_'.$cnum;
                   4472:     $setters->{$course} = {};
                   4473:     $setters->{$course}{'staff'} = [];
                   4474:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4475:     $setters->{$course}{'triggers'} = [];
                   4476:     my (@blockers,%triggered);
                   4477:     my $now = time;
                   4478:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4479:     if ($activity eq 'docs') {
                   4480:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4481:         foreach my $block (@blockers) {
                   4482:             if ($block =~ /^firstaccess____(.+)$/) {
                   4483:                 my $item = $1;
                   4484:                 my $type = 'map';
                   4485:                 my $timersymb = $item;
                   4486:                 if ($item eq 'course') {
                   4487:                     $type = 'course';
                   4488:                 } elsif ($item =~ /___\d+___/) {
                   4489:                     $type = 'resource';
                   4490:                 } else {
                   4491:                     $timersymb = &Apache::lonnet::symbread($item);
                   4492:                 }
                   4493:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4494:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4495:                 $triggered{$block} = {
                   4496:                                        start => $start,
                   4497:                                        end   => $end,
                   4498:                                        type  => $type,
                   4499:                                      };
                   4500:             }
                   4501:         }
                   4502:     } else {
                   4503:         foreach my $block (keys(%commblocks)) {
                   4504:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4505:                 my ($start,$end) = ($1,$2);
                   4506:                 if ($start <= time && $end >= time) {
                   4507:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4508:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4509:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4510:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4511:                                     push(@blockers,$block);
                   4512:                                 }
                   4513:                             }
                   4514:                         }
                   4515:                     }
                   4516:                 }
                   4517:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4518:                 my $item = $1;
                   4519:                 my $timersymb = $item; 
                   4520:                 my $type = 'map';
                   4521:                 if ($item eq 'course') {
                   4522:                     $type = 'course';
                   4523:                 } elsif ($item =~ /___\d+___/) {
                   4524:                     $type = 'resource';
                   4525:                 } else {
                   4526:                     $timersymb = &Apache::lonnet::symbread($item);
                   4527:                 }
                   4528:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4529:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4530:                 if ($start && $end) {
                   4531:                     if (($start <= time) && ($end >= time)) {
                   4532:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4533:                             push(@blockers,$block);
                   4534:                             $triggered{$block} = {
                   4535:                                                    start => $start,
                   4536:                                                    end   => $end,
                   4537:                                                    type  => $type,
                   4538:                                                  };
                   4539:                         }
                   4540:                     }
1.490     raeburn  4541:                 }
1.1062    raeburn  4542:             }
                   4543:         }
                   4544:     }
                   4545:     foreach my $blocker (@blockers) {
                   4546:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4547:             &parse_block_record($commblocks{$blocker});
                   4548:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4549:         my ($start,$end,$triggertype);
                   4550:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4551:             ($start,$end) = ($1,$2);
                   4552:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4553:             $start = $triggered{$blocker}{'start'};
                   4554:             $end = $triggered{$blocker}{'end'};
                   4555:             $triggertype = $triggered{$blocker}{'type'};
                   4556:         }
                   4557:         if ($start) {
                   4558:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4559:             if ($triggertype) {
                   4560:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4561:             } else {
                   4562:                 push(@{$$setters{$course}{'triggers'}},0);
                   4563:             }
                   4564:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4565:                 $startblock = $start;
                   4566:                 if ($triggertype) {
                   4567:                     $triggerblock = $blocker;
1.474     raeburn  4568:                 }
                   4569:             }
1.1062    raeburn  4570:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4571:                $endblock = $end;
                   4572:                if ($triggertype) {
                   4573:                    $triggerblock = $blocker;
                   4574:                }
                   4575:             }
1.474     raeburn  4576:         }
                   4577:     }
1.1062    raeburn  4578:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4579: }
                   4580: 
                   4581: sub parse_block_record {
                   4582:     my ($record) = @_;
                   4583:     my ($setuname,$setudom,$title,$blocks);
                   4584:     if (ref($record) eq 'HASH') {
                   4585:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4586:         $title = &unescape($record->{'event'});
                   4587:         $blocks = $record->{'blocks'};
                   4588:     } else {
                   4589:         my @data = split(/:/,$record,3);
                   4590:         if (scalar(@data) eq 2) {
                   4591:             $title = $data[1];
                   4592:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4593:         } else {
                   4594:             ($setuname,$setudom,$title) = @data;
                   4595:         }
                   4596:         $blocks = { 'com' => 'on' };
                   4597:     }
                   4598:     return ($setuname,$setudom,$title,$blocks);
                   4599: }
                   4600: 
1.854     kalberla 4601: sub blocking_status {
1.1062    raeburn  4602:     my ($activity,$uname,$udom,$url) = @_;
1.1061    raeburn  4603:     my %setters;
1.890     droeschl 4604: 
1.1061    raeburn  4605: # check for active blocking
1.1062    raeburn  4606:     my ($startblock,$endblock,$triggerblock) = 
                   4607:         &blockcheck(\%setters,$activity,$uname,$udom,$url);
                   4608:     my $blocked = 0;
                   4609:     if ($startblock && $endblock) {
                   4610:         $blocked = 1;
                   4611:     }
1.890     droeschl 4612: 
1.1061    raeburn  4613: # caller just wants to know whether a block is active
                   4614:     if (!wantarray) { return $blocked; }
                   4615: 
                   4616: # build a link to a popup window containing the details
                   4617:     my $querystring  = "?activity=$activity";
                   4618: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4619:     if ($activity eq 'port') {
                   4620:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4621:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4622:     } elsif ($activity eq 'docs') {
                   4623:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4624:     }
1.1061    raeburn  4625: 
                   4626:     my $output .= <<'END_MYBLOCK';
                   4627: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4628:     var options = "width=" + w + ",height=" + h + ",";
                   4629:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4630:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4631:     var newWin = window.open(url, wdwName, options);
                   4632:     newWin.focus();
                   4633: }
1.890     droeschl 4634: END_MYBLOCK
1.854     kalberla 4635: 
1.1061    raeburn  4636:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4637:   
1.1061    raeburn  4638:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4639:     my $text = &mt('Communication Blocked');
                   4640:     if ($activity eq 'docs') {
                   4641:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4642:     } elsif ($activity eq 'printout') {
                   4643:         $text = &mt('Printing Blocked');
1.1062    raeburn  4644:     }
1.1061    raeburn  4645:     $output .= <<"END_BLOCK";
1.867     kalberla 4646: <div class='LC_comblock'>
1.869     kalberla 4647:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4648:   title='$text'>
                   4649:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4650:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4651:   title='$text'>$text</a>
1.867     kalberla 4652: </div>
                   4653: 
                   4654: END_BLOCK
1.474     raeburn  4655: 
1.1061    raeburn  4656:     return ($blocked, $output);
1.854     kalberla 4657: }
1.490     raeburn  4658: 
1.60      matthew  4659: ###############################################
                   4660: 
1.682     raeburn  4661: sub check_ip_acc {
                   4662:     my ($acc)=@_;
                   4663:     &Apache::lonxml::debug("acc is $acc");
                   4664:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4665:         return 1;
                   4666:     }
                   4667:     my $allowed=0;
                   4668:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4669: 
                   4670:     my $name;
                   4671:     foreach my $pattern (split(',',$acc)) {
                   4672:         $pattern =~ s/^\s*//;
                   4673:         $pattern =~ s/\s*$//;
                   4674:         if ($pattern =~ /\*$/) {
                   4675:             #35.8.*
                   4676:             $pattern=~s/\*//;
                   4677:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4678:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4679:             #35.8.3.[34-56]
                   4680:             my $low=$2;
                   4681:             my $high=$3;
                   4682:             $pattern=$1;
                   4683:             if ($ip =~ /^\Q$pattern\E/) {
                   4684:                 my $last=(split(/\./,$ip))[3];
                   4685:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4686:             }
                   4687:         } elsif ($pattern =~ /^\*/) {
                   4688:             #*.msu.edu
                   4689:             $pattern=~s/\*//;
                   4690:             if (!defined($name)) {
                   4691:                 use Socket;
                   4692:                 my $netaddr=inet_aton($ip);
                   4693:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4694:             }
                   4695:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4696:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4697:             #127.0.0.1
                   4698:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4699:         } else {
                   4700:             #some.name.com
                   4701:             if (!defined($name)) {
                   4702:                 use Socket;
                   4703:                 my $netaddr=inet_aton($ip);
                   4704:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4705:             }
                   4706:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4707:         }
                   4708:         if ($allowed) { last; }
                   4709:     }
                   4710:     return $allowed;
                   4711: }
                   4712: 
                   4713: ###############################################
                   4714: 
1.60      matthew  4715: =pod
                   4716: 
1.112     bowersj2 4717: =head1 Domain Template Functions
                   4718: 
                   4719: =over 4
                   4720: 
                   4721: =item * &determinedomain()
1.60      matthew  4722: 
                   4723: Inputs: $domain (usually will be undef)
                   4724: 
1.63      www      4725: Returns: Determines which domain should be used for designs
1.60      matthew  4726: 
                   4727: =cut
1.54      www      4728: 
1.60      matthew  4729: ###############################################
1.63      www      4730: sub determinedomain {
                   4731:     my $domain=shift;
1.531     albertel 4732:     if (! $domain) {
1.60      matthew  4733:         # Determine domain if we have not been given one
1.893     raeburn  4734:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4735:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4736:         if ($env{'request.role.domain'}) { 
                   4737:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4738:         }
                   4739:     }
1.63      www      4740:     return $domain;
                   4741: }
                   4742: ###############################################
1.517     raeburn  4743: 
1.518     albertel 4744: sub devalidate_domconfig_cache {
                   4745:     my ($udom)=@_;
                   4746:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4747: }
                   4748: 
                   4749: # ---------------------- Get domain configuration for a domain
                   4750: sub get_domainconf {
                   4751:     my ($udom) = @_;
                   4752:     my $cachetime=1800;
                   4753:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4754:     if (defined($cached)) { return %{$result}; }
                   4755: 
                   4756:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4757: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4758:     my (%designhash,%legacy);
1.518     albertel 4759:     if (keys(%domconfig) > 0) {
                   4760:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4761:             if (keys(%{$domconfig{'login'}})) {
                   4762:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4763:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4764:                         if ($key eq 'loginvia') {
                   4765:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4766:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4767:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4768:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4769:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4770:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4771:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4772: 
                   4773:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4774:                                             } else {
1.1013    raeburn  4775:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4776:                                             }
                   4777:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4778:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4779:                                             }
1.946     raeburn  4780:                                         }
                   4781:                                     }
                   4782:                                 }
                   4783:                             }
                   4784:                         } else {
                   4785:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4786:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4787:                                     $domconfig{'login'}{$key}{$img};
                   4788:                             }
1.699     raeburn  4789:                         }
                   4790:                     } else {
                   4791:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4792:                     }
1.632     raeburn  4793:                 }
                   4794:             } else {
                   4795:                 $legacy{'login'} = 1;
1.518     albertel 4796:             }
1.632     raeburn  4797:         } else {
                   4798:             $legacy{'login'} = 1;
1.518     albertel 4799:         }
                   4800:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4801:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4802:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4803:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4804:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4805:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4806:                         }
1.518     albertel 4807:                     }
                   4808:                 }
1.632     raeburn  4809:             } else {
                   4810:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4811:             }
1.632     raeburn  4812:         } else {
                   4813:             $legacy{'rolecolors'} = 1;
1.518     albertel 4814:         }
1.948     raeburn  4815:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4816:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4817:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4818:             }
                   4819:         }
1.632     raeburn  4820:         if (keys(%legacy) > 0) {
                   4821:             my %legacyhash = &get_legacy_domconf($udom);
                   4822:             foreach my $item (keys(%legacyhash)) {
                   4823:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4824:                     if ($legacy{'login'}) { 
                   4825:                         $designhash{$item} = $legacyhash{$item};
                   4826:                     }
                   4827:                 } else {
                   4828:                     if ($legacy{'rolecolors'}) {
                   4829:                         $designhash{$item} = $legacyhash{$item};
                   4830:                     }
1.518     albertel 4831:                 }
                   4832:             }
                   4833:         }
1.632     raeburn  4834:     } else {
                   4835:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4836:     }
                   4837:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4838: 				  $cachetime);
                   4839:     return %designhash;
                   4840: }
                   4841: 
1.632     raeburn  4842: sub get_legacy_domconf {
                   4843:     my ($udom) = @_;
                   4844:     my %legacyhash;
                   4845:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4846:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4847:     if (-e $designfile) {
                   4848:         if ( open (my $fh,"<$designfile") ) {
                   4849:             while (my $line = <$fh>) {
                   4850:                 next if ($line =~ /^\#/);
                   4851:                 chomp($line);
                   4852:                 my ($key,$val)=(split(/\=/,$line));
                   4853:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4854:             }
                   4855:             close($fh);
                   4856:         }
                   4857:     }
1.1026    raeburn  4858:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4859:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4860:     }
                   4861:     return %legacyhash;
                   4862: }
                   4863: 
1.63      www      4864: =pod
                   4865: 
1.112     bowersj2 4866: =item * &domainlogo()
1.63      www      4867: 
                   4868: Inputs: $domain (usually will be undef)
                   4869: 
                   4870: Returns: A link to a domain logo, if the domain logo exists.
                   4871: If the domain logo does not exist, a description of the domain.
                   4872: 
                   4873: =cut
1.112     bowersj2 4874: 
1.63      www      4875: ###############################################
                   4876: sub domainlogo {
1.517     raeburn  4877:     my $domain = &determinedomain(shift);
1.518     albertel 4878:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4879:     # See if there is a logo
                   4880:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4881:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4882:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4883: 	    if ($imgsrc =~ m{^/res/}) {
                   4884: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4885: 		&Apache::lonnet::repcopy($local_name);
                   4886: 	    }
                   4887: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4888:         } 
                   4889:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4890:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4891:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4892:     } else {
1.60      matthew  4893:         return '';
1.59      www      4894:     }
                   4895: }
1.63      www      4896: ##############################################
                   4897: 
                   4898: =pod
                   4899: 
1.112     bowersj2 4900: =item * &designparm()
1.63      www      4901: 
                   4902: Inputs: $which parameter; $domain (usually will be undef)
                   4903: 
                   4904: Returns: value of designparamter $which
                   4905: 
                   4906: =cut
1.112     bowersj2 4907: 
1.397     albertel 4908: 
1.400     albertel 4909: ##############################################
1.397     albertel 4910: sub designparm {
                   4911:     my ($which,$domain)=@_;
                   4912:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4913:         return $env{'environment.color.'.$which};
1.96      www      4914:     }
1.63      www      4915:     $domain=&determinedomain($domain);
1.1016    raeburn  4916:     my %domdesign;
                   4917:     unless ($domain eq 'public') {
                   4918:         %domdesign = &get_domainconf($domain);
                   4919:     }
1.520     raeburn  4920:     my $output;
1.517     raeburn  4921:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4922:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4923:     } else {
1.520     raeburn  4924:         $output = $defaultdesign{$which};
                   4925:     }
                   4926:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4927:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4928:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4929:             if ($output =~ m{^/res/}) {
                   4930:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4931:                 &Apache::lonnet::repcopy($local_name);
                   4932:             }
1.520     raeburn  4933:             $output = &lonhttpdurl($output);
                   4934:         }
1.63      www      4935:     }
1.520     raeburn  4936:     return $output;
1.63      www      4937: }
1.59      www      4938: 
1.822     bisitz   4939: ##############################################
                   4940: =pod
                   4941: 
1.832     bisitz   4942: =item * &authorspace()
                   4943: 
1.1028    raeburn  4944: Inputs: $url (usually will be undef).
1.832     bisitz   4945: 
1.1132    raeburn  4946: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  4947:          directory being viewed (or for which action is being taken). 
                   4948:          If $url is provided, and begins /priv/<domain>/<uname>
                   4949:          the path will be that portion of the $context argument.
                   4950:          Otherwise the path will be for the author space of the current
                   4951:          user when the current role is author, or for that of the 
                   4952:          co-author/assistant co-author space when the current role 
                   4953:          is co-author or assistant co-author.
1.832     bisitz   4954: 
                   4955: =cut
                   4956: 
                   4957: sub authorspace {
1.1028    raeburn  4958:     my ($url) = @_;
                   4959:     if ($url ne '') {
                   4960:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4961:            return $1;
                   4962:         }
                   4963:     }
1.832     bisitz   4964:     my $caname = '';
1.1024    www      4965:     my $cadom = '';
1.1028    raeburn  4966:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4967:         ($cadom,$caname) =
1.832     bisitz   4968:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4969:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4970:         $caname = $env{'user.name'};
1.1024    www      4971:         $cadom = $env{'user.domain'};
1.832     bisitz   4972:     }
1.1028    raeburn  4973:     if (($caname ne '') && ($cadom ne '')) {
                   4974:         return "/priv/$cadom/$caname/";
                   4975:     }
                   4976:     return;
1.832     bisitz   4977: }
                   4978: 
                   4979: ##############################################
                   4980: =pod
                   4981: 
1.822     bisitz   4982: =item * &head_subbox()
                   4983: 
                   4984: Inputs: $content (contains HTML code with page functions, etc.)
                   4985: 
                   4986: Returns: HTML div with $content
                   4987:          To be included in page header
                   4988: 
                   4989: =cut
                   4990: 
                   4991: sub head_subbox {
                   4992:     my ($content)=@_;
                   4993:     my $output =
1.993     raeburn  4994:         '<div class="LC_head_subbox">'
1.822     bisitz   4995:        .$content
                   4996:        .'</div>'
                   4997: }
                   4998: 
                   4999: ##############################################
                   5000: =pod
                   5001: 
                   5002: =item * &CSTR_pageheader()
                   5003: 
1.1026    raeburn  5004: Input: (optional) filename from which breadcrumb trail is built.
                   5005:        In most cases no input as needed, as $env{'request.filename'}
                   5006:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5007: 
                   5008: Returns: HTML div with CSTR path and recent box
1.1132    raeburn  5009:          To be included on Authoring Space pages
1.822     bisitz   5010: 
                   5011: =cut
                   5012: 
                   5013: sub CSTR_pageheader {
1.1026    raeburn  5014:     my ($trailfile) = @_;
                   5015:     if ($trailfile eq '') {
                   5016:         $trailfile = $env{'request.filename'};
                   5017:     }
                   5018: 
                   5019: # this is for resources; directories have customtitle, and crumbs
                   5020: # and select recent are created in lonpubdir.pm
                   5021: 
                   5022:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5023:     my ($udom,$uname,$thisdisfn)=
1.1113    raeburn  5024:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5025:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5026:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5027: 
                   5028:     my $parentpath = '';
                   5029:     my $lastitem = '';
                   5030:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5031:         $parentpath = $1;
                   5032:         $lastitem = $2;
                   5033:     } else {
                   5034:         $lastitem = $thisdisfn;
                   5035:     }
1.921     bisitz   5036: 
                   5037:     my $output =
1.822     bisitz   5038:          '<div>'
                   5039:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132    raeburn  5040:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   5041:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5042:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5043:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5044: 
                   5045:     if ($lastitem) {
                   5046:         $output .=
                   5047:              '<span class="LC_filename">'
                   5048:             .$lastitem
                   5049:             .'</span>';
                   5050:     }
                   5051:     $output .=
                   5052:          '<br />'
1.822     bisitz   5053:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5054:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5055:         .'</form>'
                   5056:         .&Apache::lonmenu::constspaceform()
                   5057:         .'</div>';
1.921     bisitz   5058: 
                   5059:     return $output;
1.822     bisitz   5060: }
                   5061: 
1.60      matthew  5062: ###############################################
                   5063: ###############################################
                   5064: 
                   5065: =pod
                   5066: 
1.112     bowersj2 5067: =back
                   5068: 
1.549     albertel 5069: =head1 HTML Helpers
1.112     bowersj2 5070: 
                   5071: =over 4
                   5072: 
                   5073: =item * &bodytag()
1.60      matthew  5074: 
                   5075: Returns a uniform header for LON-CAPA web pages.
                   5076: 
                   5077: Inputs: 
                   5078: 
1.112     bowersj2 5079: =over 4
                   5080: 
                   5081: =item * $title, A title to be displayed on the page.
                   5082: 
                   5083: =item * $function, the current role (can be undef).
                   5084: 
                   5085: =item * $addentries, extra parameters for the <body> tag.
                   5086: 
                   5087: =item * $bodyonly, if defined, only return the <body> tag.
                   5088: 
                   5089: =item * $domain, if defined, force a given domain.
                   5090: 
                   5091: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5092:             text interface only)
1.60      matthew  5093: 
1.814     bisitz   5094: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5095:                      navigational links
1.317     albertel 5096: 
1.338     albertel 5097: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5098: 
1.460     albertel 5099: =item * $args, optional argument valid values are
                   5100:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5101:             inherit_jsmath -> when creating popup window in a page,
                   5102:                               should it have jsmath forced on by the
                   5103:                               current page
1.460     albertel 5104: 
1.1096    raeburn  5105: =item * $advtoolsref, optional argument, ref to an array containing
                   5106:             inlineremote items to be added in "Functions" menu below
                   5107:             breadcrumbs.
                   5108: 
1.112     bowersj2 5109: =back
                   5110: 
1.60      matthew  5111: Returns: A uniform header for LON-CAPA web pages.  
                   5112: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5113: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5114: other decorations will be returned.
                   5115: 
                   5116: =cut
                   5117: 
1.54      www      5118: sub bodytag {
1.831     bisitz   5119:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096    raeburn  5120:         $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339     albertel 5121: 
1.954     raeburn  5122:     my $public;
                   5123:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5124:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5125:         $public = 1;
                   5126:     }
1.460     albertel 5127:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154    raeburn  5128:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5129: 
1.183     matthew  5130:     $function = &get_users_function() if (!$function);
1.339     albertel 5131:     my $img =    &designparm($function.'.img',$domain);
                   5132:     my $font =   &designparm($function.'.font',$domain);
                   5133:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5134: 
1.803     bisitz   5135:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5136: 		   'bgcolor' => $pgbg,
1.339     albertel 5137: 		   'text'    => $font,
                   5138:                    'alink'   => &designparm($function.'.alink',$domain),
                   5139: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5140: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5141:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5142: 
1.63      www      5143:  # role and realm
1.378     raeburn  5144:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   5145:     if ($role  eq 'ca') {
1.479     albertel 5146:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5147:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5148:     } 
1.55      www      5149: # realm
1.258     albertel 5150:     if ($env{'request.course.id'}) {
1.378     raeburn  5151:         if ($env{'request.role'} !~ /^cr/) {
                   5152:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5153:         }
1.898     raeburn  5154:         if ($env{'request.course.sec'}) {
                   5155:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5156:         }   
1.359     albertel 5157: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5158:     } else {
                   5159:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5160:     }
1.433     albertel 5161: 
1.359     albertel 5162:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5163: 
1.438     albertel 5164:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5165: 
1.101     www      5166: # construct main body tag
1.359     albertel 5167:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5168: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5169: 
1.1131    raeburn  5170:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5171: 
1.1130    raeburn  5172:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5173:         return $bodytag;
1.1130    raeburn  5174:     }
1.359     albertel 5175: 
1.954     raeburn  5176:     if ($public) {
1.433     albertel 5177: 	undef($role);
                   5178:     }
1.359     albertel 5179:     
1.762     bisitz   5180:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5181:     #
                   5182:     # Extra info if you are the DC
                   5183:     my $dc_info = '';
                   5184:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5185:                         $env{'course.'.$env{'request.course.id'}.
                   5186:                                  '.domain'}.'/'})) {
                   5187:         my $cid = $env{'request.course.id'};
1.917     raeburn  5188:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5189:         $dc_info =~ s/\s+$//;
1.359     albertel 5190:     }
                   5191: 
1.898     raeburn  5192:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 5193: 
1.903     droeschl 5194:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5195: 
                   5196:         #    if ($env{'request.state'} eq 'construct') {
                   5197:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5198:         #    }
                   5199: 
1.1130    raeburn  5200:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154    raeburn  5201:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5202: 
1.1130    raeburn  5203:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.359     albertel 5204: 
1.916     droeschl 5205:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  5206:              if ($dc_info) {
                   5207:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   5208:              }
1.1130    raeburn  5209:              $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916     droeschl 5210:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5211:             return $bodytag;
                   5212:         }
1.894     droeschl 5213: 
1.927     raeburn  5214:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130    raeburn  5215:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5216:         }
1.916     droeschl 5217: 
1.1130    raeburn  5218:         $bodytag .= $right;
1.852     droeschl 5219: 
1.917     raeburn  5220:         if ($dc_info) {
                   5221:             $dc_info = &dc_courseid_toggle($dc_info);
                   5222:         }
                   5223:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5224: 
1.903     droeschl 5225:         #don't show menus for public users
1.954     raeburn  5226:         if (!$public){
1.1154    raeburn  5227:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5228:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5229:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5230:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5231:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5232:                                 $args->{'bread_crumbs'});
1.1096    raeburn  5233:             } elsif ($forcereg) {
                   5234:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5235:                                                             $args->{'group'});
                   5236:             } else {
                   5237:                 $bodytag .= 
                   5238:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5239:                                                         $forcereg,$args->{'group'},
                   5240:                                                         $args->{'bread_crumbs'},
                   5241:                                                         $advtoolsref);
1.920     raeburn  5242:             }
1.903     droeschl 5243:         }else{
                   5244:             # this is to seperate menu from content when there's no secondary
                   5245:             # menu. Especially needed for public accessible ressources.
                   5246:             $bodytag .= '<hr style="clear:both" />';
                   5247:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5248:         }
1.903     droeschl 5249: 
1.235     raeburn  5250:         return $bodytag;
1.182     matthew  5251: }
                   5252: 
1.917     raeburn  5253: sub dc_courseid_toggle {
                   5254:     my ($dc_info) = @_;
1.980     raeburn  5255:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5256:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5257:            &mt('(More ...)').'</a></span>'.
                   5258:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5259: }
                   5260: 
1.330     albertel 5261: sub make_attr_string {
                   5262:     my ($register,$attr_ref) = @_;
                   5263: 
                   5264:     if ($attr_ref && !ref($attr_ref)) {
                   5265: 	die("addentries Must be a hash ref ".
                   5266: 	    join(':',caller(1))." ".
                   5267: 	    join(':',caller(0))." ");
                   5268:     }
                   5269: 
                   5270:     if ($register) {
1.339     albertel 5271: 	my ($on_load,$on_unload);
                   5272: 	foreach my $key (keys(%{$attr_ref})) {
                   5273: 	    if      (lc($key) eq 'onload') {
                   5274: 		$on_load.=$attr_ref->{$key}.';';
                   5275: 		delete($attr_ref->{$key});
                   5276: 
                   5277: 	    } elsif (lc($key) eq 'onunload') {
                   5278: 		$on_unload.=$attr_ref->{$key}.';';
                   5279: 		delete($attr_ref->{$key});
                   5280: 	    }
                   5281: 	}
1.953     droeschl 5282: 	$attr_ref->{'onload'}  = $on_load;
                   5283: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 5284:     }
1.339     albertel 5285: 
1.330     albertel 5286:     my $attr_string;
                   5287:     foreach my $attr (keys(%$attr_ref)) {
                   5288: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5289:     }
                   5290:     return $attr_string;
                   5291: }
                   5292: 
                   5293: 
1.182     matthew  5294: ###############################################
1.251     albertel 5295: ###############################################
                   5296: 
                   5297: =pod
                   5298: 
                   5299: =item * &endbodytag()
                   5300: 
                   5301: Returns a uniform footer for LON-CAPA web pages.
                   5302: 
1.635     raeburn  5303: Inputs: 1 - optional reference to an args hash
                   5304: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5305: a 'Continue' link is not displayed if the page contains an
                   5306: internal redirect in the <head></head> section,
                   5307: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5308: 
                   5309: =cut
                   5310: 
                   5311: sub endbodytag {
1.635     raeburn  5312:     my ($args) = @_;
1.1080    raeburn  5313:     my $endbodytag;
                   5314:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5315:         $endbodytag='</body>';
                   5316:     }
1.269     albertel 5317:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5318:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5319:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5320: 	    $endbodytag=
                   5321: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5322: 	        &mt('Continue').'</a>'.
                   5323: 	        $endbodytag;
                   5324:         }
1.315     albertel 5325:     }
1.251     albertel 5326:     return $endbodytag;
                   5327: }
                   5328: 
1.352     albertel 5329: =pod
                   5330: 
                   5331: =item * &standard_css()
                   5332: 
                   5333: Returns a style sheet
                   5334: 
                   5335: Inputs: (all optional)
                   5336:             domain         -> force to color decorate a page for a specific
                   5337:                                domain
                   5338:             function       -> force usage of a specific rolish color scheme
                   5339:             bgcolor        -> override the default page bgcolor
                   5340: 
                   5341: =cut
                   5342: 
1.343     albertel 5343: sub standard_css {
1.345     albertel 5344:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5345:     $function  = &get_users_function() if (!$function);
                   5346:     my $img    = &designparm($function.'.img',   $domain);
                   5347:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5348:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5349:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5350: #second colour for later usage
1.345     albertel 5351:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5352:     my $pgbg_or_bgcolor =
                   5353: 	         $bgcolor ||
1.352     albertel 5354: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5355:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5356:     my $alink  = &designparm($function.'.alink', $domain);
                   5357:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5358:     my $link   = &designparm($function.'.link',  $domain);
                   5359: 
1.602     albertel 5360:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5361:     my $mono                 = 'monospace';
1.850     bisitz   5362:     my $data_table_head      = $sidebg;
                   5363:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5364:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5365:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5366:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5367:     my $mail_new             = '#FFBB77';
                   5368:     my $mail_new_hover       = '#DD9955';
                   5369:     my $mail_read            = '#BBBB77';
                   5370:     my $mail_read_hover      = '#999944';
                   5371:     my $mail_replied         = '#AAAA88';
                   5372:     my $mail_replied_hover   = '#888855';
                   5373:     my $mail_other           = '#99BBBB';
                   5374:     my $mail_other_hover     = '#669999';
1.391     albertel 5375:     my $table_header         = '#DDDDDD';
1.489     raeburn  5376:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5377:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5378:     my $button_hover         = '#BF2317';
1.392     albertel 5379: 
1.608     albertel 5380:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5381:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5382:                                              : '0 3px 0 4px';
1.448     albertel 5383: 
1.523     albertel 5384: 
1.343     albertel 5385:     return <<END;
1.947     droeschl 5386: 
                   5387: /* needed for iframe to allow 100% height in FF */
                   5388: body, html { 
                   5389:     margin: 0;
                   5390:     padding: 0 0.5%;
                   5391:     height: 99%; /* to avoid scrollbars */
                   5392: }
                   5393: 
1.795     www      5394: body {
1.911     bisitz   5395:   font-family: $sans;
                   5396:   line-height:130%;
                   5397:   font-size:0.83em;
                   5398:   color:$font;
1.795     www      5399: }
                   5400: 
1.959     onken    5401: a:focus,
                   5402: a:focus img {
1.795     www      5403:   color: red;
                   5404: }
1.698     harmsja  5405: 
1.911     bisitz   5406: form, .inline {
                   5407:   display: inline;
1.795     www      5408: }
1.721     harmsja  5409: 
1.795     www      5410: .LC_right {
1.911     bisitz   5411:   text-align:right;
1.795     www      5412: }
                   5413: 
                   5414: .LC_middle {
1.911     bisitz   5415:   vertical-align:middle;
1.795     www      5416: }
1.721     harmsja  5417: 
1.1130    raeburn  5418: .LC_floatleft {
                   5419:   float: left;
                   5420: }
                   5421: 
                   5422: .LC_floatright {
                   5423:   float: right;
                   5424: }
                   5425: 
1.911     bisitz   5426: .LC_400Box {
                   5427:   width:400px;
                   5428: }
1.721     harmsja  5429: 
1.947     droeschl 5430: .LC_iframecontainer {
                   5431:     width: 98%;
                   5432:     margin: 0;
                   5433:     position: fixed;
                   5434:     top: 8.5em;
                   5435:     bottom: 0;
                   5436: }
                   5437: 
                   5438: .LC_iframecontainer iframe{
                   5439:     border: none;
                   5440:     width: 100%;
                   5441:     height: 100%;
                   5442: }
                   5443: 
1.778     bisitz   5444: .LC_filename {
                   5445:   font-family: $mono;
                   5446:   white-space:pre;
1.921     bisitz   5447:   font-size: 120%;
1.778     bisitz   5448: }
                   5449: 
                   5450: .LC_fileicon {
                   5451:   border: none;
                   5452:   height: 1.3em;
                   5453:   vertical-align: text-bottom;
                   5454:   margin-right: 0.3em;
                   5455:   text-decoration:none;
                   5456: }
                   5457: 
1.1008    www      5458: .LC_setting {
                   5459:   text-decoration:underline;
                   5460: }
                   5461: 
1.350     albertel 5462: .LC_error {
                   5463:   color: red;
                   5464: }
1.795     www      5465: 
1.1097    bisitz   5466: .LC_warning {
                   5467:   color: darkorange;
                   5468: }
                   5469: 
1.457     albertel 5470: .LC_diff_removed {
1.733     bisitz   5471:   color: red;
1.394     albertel 5472: }
1.532     albertel 5473: 
                   5474: .LC_info,
1.457     albertel 5475: .LC_success,
                   5476: .LC_diff_added {
1.350     albertel 5477:   color: green;
                   5478: }
1.795     www      5479: 
1.802     bisitz   5480: div.LC_confirm_box {
                   5481:   background-color: #FAFAFA;
                   5482:   border: 1px solid $lg_border_color;
                   5483:   margin-right: 0;
                   5484:   padding: 5px;
                   5485: }
                   5486: 
                   5487: div.LC_confirm_box .LC_error img,
                   5488: div.LC_confirm_box .LC_success img {
                   5489:   vertical-align: middle;
                   5490: }
                   5491: 
1.440     albertel 5492: .LC_icon {
1.771     droeschl 5493:   border: none;
1.790     droeschl 5494:   vertical-align: middle;
1.771     droeschl 5495: }
                   5496: 
1.543     albertel 5497: .LC_docs_spacer {
                   5498:   width: 25px;
                   5499:   height: 1px;
1.771     droeschl 5500:   border: none;
1.543     albertel 5501: }
1.346     albertel 5502: 
1.532     albertel 5503: .LC_internal_info {
1.735     bisitz   5504:   color: #999999;
1.532     albertel 5505: }
                   5506: 
1.794     www      5507: .LC_discussion {
1.1050    www      5508:   background: $data_table_dark;
1.911     bisitz   5509:   border: 1px solid black;
                   5510:   margin: 2px;
1.794     www      5511: }
                   5512: 
                   5513: .LC_disc_action_left {
1.1050    www      5514:   background: $sidebg;
1.911     bisitz   5515:   text-align: left;
1.1050    www      5516:   padding: 4px;
                   5517:   margin: 2px;
1.794     www      5518: }
                   5519: 
                   5520: .LC_disc_action_right {
1.1050    www      5521:   background: $sidebg;
1.911     bisitz   5522:   text-align: right;
1.1050    www      5523:   padding: 4px;
                   5524:   margin: 2px;
1.794     www      5525: }
                   5526: 
                   5527: .LC_disc_new_item {
1.911     bisitz   5528:   background: white;
                   5529:   border: 2px solid red;
1.1050    www      5530:   margin: 4px;
                   5531:   padding: 4px;
1.794     www      5532: }
                   5533: 
                   5534: .LC_disc_old_item {
1.911     bisitz   5535:   background: white;
1.1050    www      5536:   margin: 4px;
                   5537:   padding: 4px;
1.794     www      5538: }
                   5539: 
1.458     albertel 5540: table.LC_pastsubmission {
                   5541:   border: 1px solid black;
                   5542:   margin: 2px;
                   5543: }
                   5544: 
1.924     bisitz   5545: table#LC_menubuttons {
1.345     albertel 5546:   width: 100%;
                   5547:   background: $pgbg;
1.392     albertel 5548:   border: 2px;
1.402     albertel 5549:   border-collapse: separate;
1.803     bisitz   5550:   padding: 0;
1.345     albertel 5551: }
1.392     albertel 5552: 
1.801     tempelho 5553: table#LC_title_bar a {
                   5554:   color: $fontmenu;
                   5555: }
1.836     bisitz   5556: 
1.807     droeschl 5557: table#LC_title_bar {
1.819     tempelho 5558:   clear: both;
1.836     bisitz   5559:   display: none;
1.807     droeschl 5560: }
                   5561: 
1.795     www      5562: table#LC_title_bar,
1.933     droeschl 5563: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5564: table#LC_title_bar.LC_with_remote {
1.359     albertel 5565:   width: 100%;
1.392     albertel 5566:   border-color: $pgbg;
                   5567:   border-style: solid;
                   5568:   border-width: $border;
1.379     albertel 5569:   background: $pgbg;
1.801     tempelho 5570:   color: $fontmenu;
1.392     albertel 5571:   border-collapse: collapse;
1.803     bisitz   5572:   padding: 0;
1.819     tempelho 5573:   margin: 0;
1.359     albertel 5574: }
1.795     www      5575: 
1.933     droeschl 5576: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5577:     margin: 0;
                   5578:     padding: 0;
1.933     droeschl 5579:     position: relative;
                   5580:     list-style: none;
1.913     droeschl 5581: }
1.933     droeschl 5582: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5583:     display: inline;
                   5584: }
1.933     droeschl 5585: 
                   5586: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5587:     padding: 0;
1.933     droeschl 5588:     margin: 0;
                   5589:     float: left;
1.913     droeschl 5590: }
1.933     droeschl 5591: .LC_breadcrumb_tools_tools {
                   5592:     padding: 0;
                   5593:     margin: 0;
1.913     droeschl 5594:     float: right;
                   5595: }
                   5596: 
1.359     albertel 5597: table#LC_title_bar td {
                   5598:   background: $tabbg;
                   5599: }
1.795     www      5600: 
1.911     bisitz   5601: table#LC_menubuttons img {
1.803     bisitz   5602:   border: none;
1.346     albertel 5603: }
1.795     www      5604: 
1.842     droeschl 5605: .LC_breadcrumbs_component {
1.911     bisitz   5606:   float: right;
                   5607:   margin: 0 1em;
1.357     albertel 5608: }
1.842     droeschl 5609: .LC_breadcrumbs_component img {
1.911     bisitz   5610:   vertical-align: middle;
1.777     tempelho 5611: }
1.795     www      5612: 
1.383     albertel 5613: td.LC_table_cell_checkbox {
                   5614:   text-align: center;
                   5615: }
1.795     www      5616: 
                   5617: .LC_fontsize_small {
1.911     bisitz   5618:   font-size: 70%;
1.705     tempelho 5619: }
                   5620: 
1.844     bisitz   5621: #LC_breadcrumbs {
1.911     bisitz   5622:   clear:both;
                   5623:   background: $sidebg;
                   5624:   border-bottom: 1px solid $lg_border_color;
                   5625:   line-height: 2.5em;
1.933     droeschl 5626:   overflow: hidden;
1.911     bisitz   5627:   margin: 0;
                   5628:   padding: 0;
1.995     raeburn  5629:   text-align: left;
1.819     tempelho 5630: }
1.862     bisitz   5631: 
1.1098    bisitz   5632: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5633:   clear:both;
                   5634:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5635:   border: 1px solid $sidebg;
1.1098    bisitz   5636:   margin: 0 0 10px 0;
1.966     bisitz   5637:   padding: 3px;
1.995     raeburn  5638:   text-align: left;
1.822     bisitz   5639: }
                   5640: 
1.795     www      5641: .LC_fontsize_medium {
1.911     bisitz   5642:   font-size: 85%;
1.705     tempelho 5643: }
                   5644: 
1.795     www      5645: .LC_fontsize_large {
1.911     bisitz   5646:   font-size: 120%;
1.705     tempelho 5647: }
                   5648: 
1.346     albertel 5649: .LC_menubuttons_inline_text {
                   5650:   color: $font;
1.698     harmsja  5651:   font-size: 90%;
1.701     harmsja  5652:   padding-left:3px;
1.346     albertel 5653: }
                   5654: 
1.934     droeschl 5655: .LC_menubuttons_inline_text img{
                   5656:   vertical-align: middle;
                   5657: }
                   5658: 
1.1051    www      5659: li.LC_menubuttons_inline_text img {
1.951     onken    5660:   cursor:pointer;
1.1002    droeschl 5661:   text-decoration: none;
1.951     onken    5662: }
                   5663: 
1.526     www      5664: .LC_menubuttons_link {
                   5665:   text-decoration: none;
                   5666: }
1.795     www      5667: 
1.522     albertel 5668: .LC_menubuttons_category {
1.521     www      5669:   color: $font;
1.526     www      5670:   background: $pgbg;
1.521     www      5671:   font-size: larger;
                   5672:   font-weight: bold;
                   5673: }
                   5674: 
1.346     albertel 5675: td.LC_menubuttons_text {
1.911     bisitz   5676:   color: $font;
1.346     albertel 5677: }
1.706     harmsja  5678: 
1.346     albertel 5679: .LC_current_location {
                   5680:   background: $tabbg;
                   5681: }
1.795     www      5682: 
1.938     bisitz   5683: table.LC_data_table {
1.347     albertel 5684:   border: 1px solid #000000;
1.402     albertel 5685:   border-collapse: separate;
1.426     albertel 5686:   border-spacing: 1px;
1.610     albertel 5687:   background: $pgbg;
1.347     albertel 5688: }
1.795     www      5689: 
1.422     albertel 5690: .LC_data_table_dense {
                   5691:   font-size: small;
                   5692: }
1.795     www      5693: 
1.507     raeburn  5694: table.LC_nested_outer {
                   5695:   border: 1px solid #000000;
1.589     raeburn  5696:   border-collapse: collapse;
1.803     bisitz   5697:   border-spacing: 0;
1.507     raeburn  5698:   width: 100%;
                   5699: }
1.795     www      5700: 
1.879     raeburn  5701: table.LC_innerpickbox,
1.507     raeburn  5702: table.LC_nested {
1.803     bisitz   5703:   border: none;
1.589     raeburn  5704:   border-collapse: collapse;
1.803     bisitz   5705:   border-spacing: 0;
1.507     raeburn  5706:   width: 100%;
                   5707: }
1.795     www      5708: 
1.911     bisitz   5709: table.LC_data_table tr th,
                   5710: table.LC_calendar tr th,
1.879     raeburn  5711: table.LC_prior_tries tr th,
                   5712: table.LC_innerpickbox tr th {
1.349     albertel 5713:   font-weight: bold;
                   5714:   background-color: $data_table_head;
1.801     tempelho 5715:   color:$fontmenu;
1.701     harmsja  5716:   font-size:90%;
1.347     albertel 5717: }
1.795     www      5718: 
1.879     raeburn  5719: table.LC_innerpickbox tr th,
                   5720: table.LC_innerpickbox tr td {
                   5721:   vertical-align: top;
                   5722: }
                   5723: 
1.711     raeburn  5724: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5725:   background-color: #CCCCCC;
1.711     raeburn  5726:   font-weight: bold;
                   5727:   text-align: left;
                   5728: }
1.795     www      5729: 
1.912     bisitz   5730: table.LC_data_table tr.LC_odd_row > td {
                   5731:   background-color: $data_table_light;
                   5732:   padding: 2px;
                   5733:   vertical-align: top;
                   5734: }
                   5735: 
1.809     bisitz   5736: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5737:   background-color: $data_table_light;
1.912     bisitz   5738:   vertical-align: top;
                   5739: }
                   5740: 
                   5741: table.LC_data_table tr.LC_even_row > td {
                   5742:   background-color: $data_table_dark;
1.425     albertel 5743:   padding: 2px;
1.900     bisitz   5744:   vertical-align: top;
1.347     albertel 5745: }
1.795     www      5746: 
1.809     bisitz   5747: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5748:   background-color: $data_table_dark;
1.900     bisitz   5749:   vertical-align: top;
1.347     albertel 5750: }
1.795     www      5751: 
1.425     albertel 5752: table.LC_data_table tr.LC_data_table_highlight td {
                   5753:   background-color: $data_table_darker;
                   5754: }
1.795     www      5755: 
1.639     raeburn  5756: table.LC_data_table tr td.LC_leftcol_header {
                   5757:   background-color: $data_table_head;
                   5758:   font-weight: bold;
                   5759: }
1.795     www      5760: 
1.451     albertel 5761: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5762: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5763:   font-weight: bold;
                   5764:   font-style: italic;
                   5765:   text-align: center;
                   5766:   padding: 8px;
1.347     albertel 5767: }
1.795     www      5768: 
1.1114    raeburn  5769: table.LC_data_table tr.LC_empty_row td,
                   5770: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   5771:   background-color: $sidebg;
                   5772: }
                   5773: 
                   5774: table.LC_nested tr.LC_empty_row td {
                   5775:   background-color: #FFFFFF;
                   5776: }
                   5777: 
1.890     droeschl 5778: table.LC_caption {
                   5779: }
                   5780: 
1.507     raeburn  5781: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5782:   padding: 4ex
                   5783: }
1.795     www      5784: 
1.507     raeburn  5785: table.LC_nested_outer tr th {
                   5786:   font-weight: bold;
1.801     tempelho 5787:   color:$fontmenu;
1.507     raeburn  5788:   background-color: $data_table_head;
1.701     harmsja  5789:   font-size: small;
1.507     raeburn  5790:   border-bottom: 1px solid #000000;
                   5791: }
1.795     www      5792: 
1.507     raeburn  5793: table.LC_nested_outer tr td.LC_subheader {
                   5794:   background-color: $data_table_head;
                   5795:   font-weight: bold;
                   5796:   font-size: small;
                   5797:   border-bottom: 1px solid #000000;
                   5798:   text-align: right;
1.451     albertel 5799: }
1.795     www      5800: 
1.507     raeburn  5801: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5802:   background-color: #CCCCCC;
1.451     albertel 5803:   font-weight: bold;
                   5804:   font-size: small;
1.507     raeburn  5805:   text-align: center;
                   5806: }
1.795     www      5807: 
1.589     raeburn  5808: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5809: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5810:   text-align: left;
1.451     albertel 5811: }
1.795     www      5812: 
1.507     raeburn  5813: table.LC_nested td {
1.735     bisitz   5814:   background-color: #FFFFFF;
1.451     albertel 5815:   font-size: small;
1.507     raeburn  5816: }
1.795     www      5817: 
1.507     raeburn  5818: table.LC_nested_outer tr th.LC_right_item,
                   5819: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5820: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5821: table.LC_nested tr td.LC_right_item {
1.451     albertel 5822:   text-align: right;
                   5823: }
                   5824: 
1.507     raeburn  5825: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5826:   background-color: #EEEEEE;
1.451     albertel 5827: }
                   5828: 
1.473     raeburn  5829: table.LC_createuser {
                   5830: }
                   5831: 
                   5832: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5833:   font-size: small;
1.473     raeburn  5834: }
                   5835: 
                   5836: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5837:   background-color: #CCCCCC;
1.473     raeburn  5838:   font-weight: bold;
                   5839:   text-align: center;
                   5840: }
                   5841: 
1.349     albertel 5842: table.LC_calendar {
                   5843:   border: 1px solid #000000;
                   5844:   border-collapse: collapse;
1.917     raeburn  5845:   width: 98%;
1.349     albertel 5846: }
1.795     www      5847: 
1.349     albertel 5848: table.LC_calendar_pickdate {
                   5849:   font-size: xx-small;
                   5850: }
1.795     www      5851: 
1.349     albertel 5852: table.LC_calendar tr td {
                   5853:   border: 1px solid #000000;
                   5854:   vertical-align: top;
1.917     raeburn  5855:   width: 14%;
1.349     albertel 5856: }
1.795     www      5857: 
1.349     albertel 5858: table.LC_calendar tr td.LC_calendar_day_empty {
                   5859:   background-color: $data_table_dark;
                   5860: }
1.795     www      5861: 
1.779     bisitz   5862: table.LC_calendar tr td.LC_calendar_day_current {
                   5863:   background-color: $data_table_highlight;
1.777     tempelho 5864: }
1.795     www      5865: 
1.938     bisitz   5866: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5867:   background-color: $mail_new;
                   5868: }
1.795     www      5869: 
1.938     bisitz   5870: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5871:   background-color: $mail_new_hover;
                   5872: }
1.795     www      5873: 
1.938     bisitz   5874: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5875:   background-color: $mail_read;
                   5876: }
1.795     www      5877: 
1.938     bisitz   5878: /*
                   5879: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5880:   background-color: $mail_read_hover;
                   5881: }
1.938     bisitz   5882: */
1.795     www      5883: 
1.938     bisitz   5884: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5885:   background-color: $mail_replied;
                   5886: }
1.795     www      5887: 
1.938     bisitz   5888: /*
                   5889: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5890:   background-color: $mail_replied_hover;
                   5891: }
1.938     bisitz   5892: */
1.795     www      5893: 
1.938     bisitz   5894: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5895:   background-color: $mail_other;
                   5896: }
1.795     www      5897: 
1.938     bisitz   5898: /*
                   5899: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5900:   background-color: $mail_other_hover;
                   5901: }
1.938     bisitz   5902: */
1.494     raeburn  5903: 
1.777     tempelho 5904: table.LC_data_table tr > td.LC_browser_file,
                   5905: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5906:   background: #AAEE77;
1.389     albertel 5907: }
1.795     www      5908: 
1.777     tempelho 5909: table.LC_data_table tr > td.LC_browser_file_locked,
                   5910: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5911:   background: #FFAA99;
1.387     albertel 5912: }
1.795     www      5913: 
1.777     tempelho 5914: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5915:   background: #888888;
1.779     bisitz   5916: }
1.795     www      5917: 
1.777     tempelho 5918: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5919: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5920:   background: #F8F866;
1.777     tempelho 5921: }
1.795     www      5922: 
1.696     bisitz   5923: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5924:   background: #E0E8FF;
1.387     albertel 5925: }
1.696     bisitz   5926: 
1.707     bisitz   5927: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5928:   /* background: #77FF77; */
1.707     bisitz   5929: }
1.795     www      5930: 
1.707     bisitz   5931: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5932:   border-right: 8px solid #FFFF77;
1.707     bisitz   5933: }
1.795     www      5934: 
1.707     bisitz   5935: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5936:   border-right: 8px solid #FFAA77;
1.707     bisitz   5937: }
1.795     www      5938: 
1.707     bisitz   5939: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5940:   border-right: 8px solid #FF7777;
1.707     bisitz   5941: }
1.795     www      5942: 
1.707     bisitz   5943: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5944:   border-right: 8px solid #AAFF77;
1.707     bisitz   5945: }
1.795     www      5946: 
1.707     bisitz   5947: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5948:   border-right: 8px solid #11CC55;
1.707     bisitz   5949: }
                   5950: 
1.388     albertel 5951: span.LC_current_location {
1.701     harmsja  5952:   font-size:larger;
1.388     albertel 5953:   background: $pgbg;
                   5954: }
1.387     albertel 5955: 
1.1029    www      5956: span.LC_current_nav_location {
                   5957:   font-weight:bold;
                   5958:   background: $sidebg;
                   5959: }
                   5960: 
1.395     albertel 5961: span.LC_parm_menu_item {
                   5962:   font-size: larger;
                   5963: }
1.795     www      5964: 
1.395     albertel 5965: span.LC_parm_scope_all {
                   5966:   color: red;
                   5967: }
1.795     www      5968: 
1.395     albertel 5969: span.LC_parm_scope_folder {
                   5970:   color: green;
                   5971: }
1.795     www      5972: 
1.395     albertel 5973: span.LC_parm_scope_resource {
                   5974:   color: orange;
                   5975: }
1.795     www      5976: 
1.395     albertel 5977: span.LC_parm_part {
                   5978:   color: blue;
                   5979: }
1.795     www      5980: 
1.911     bisitz   5981: span.LC_parm_folder,
                   5982: span.LC_parm_symb {
1.395     albertel 5983:   font-size: x-small;
                   5984:   font-family: $mono;
                   5985:   color: #AAAAAA;
                   5986: }
                   5987: 
1.977     bisitz   5988: ul.LC_parm_parmlist li {
                   5989:   display: inline-block;
                   5990:   padding: 0.3em 0.8em;
                   5991:   vertical-align: top;
                   5992:   width: 150px;
                   5993:   border-top:1px solid $lg_border_color;
                   5994: }
                   5995: 
1.795     www      5996: td.LC_parm_overview_level_menu,
                   5997: td.LC_parm_overview_map_menu,
                   5998: td.LC_parm_overview_parm_selectors,
                   5999: td.LC_parm_overview_restrictions  {
1.396     albertel 6000:   border: 1px solid black;
                   6001:   border-collapse: collapse;
                   6002: }
1.795     www      6003: 
1.396     albertel 6004: table.LC_parm_overview_restrictions td {
                   6005:   border-width: 1px 4px 1px 4px;
                   6006:   border-style: solid;
                   6007:   border-color: $pgbg;
                   6008:   text-align: center;
                   6009: }
1.795     www      6010: 
1.396     albertel 6011: table.LC_parm_overview_restrictions th {
                   6012:   background: $tabbg;
                   6013:   border-width: 1px 4px 1px 4px;
                   6014:   border-style: solid;
                   6015:   border-color: $pgbg;
                   6016: }
1.795     www      6017: 
1.398     albertel 6018: table#LC_helpmenu {
1.803     bisitz   6019:   border: none;
1.398     albertel 6020:   height: 55px;
1.803     bisitz   6021:   border-spacing: 0;
1.398     albertel 6022: }
                   6023: 
                   6024: table#LC_helpmenu fieldset legend {
                   6025:   font-size: larger;
                   6026: }
1.795     www      6027: 
1.397     albertel 6028: table#LC_helpmenu_links {
                   6029:   width: 100%;
                   6030:   border: 1px solid black;
                   6031:   background: $pgbg;
1.803     bisitz   6032:   padding: 0;
1.397     albertel 6033:   border-spacing: 1px;
                   6034: }
1.795     www      6035: 
1.397     albertel 6036: table#LC_helpmenu_links tr td {
                   6037:   padding: 1px;
                   6038:   background: $tabbg;
1.399     albertel 6039:   text-align: center;
                   6040:   font-weight: bold;
1.397     albertel 6041: }
1.396     albertel 6042: 
1.795     www      6043: table#LC_helpmenu_links a:link,
                   6044: table#LC_helpmenu_links a:visited,
1.397     albertel 6045: table#LC_helpmenu_links a:active {
                   6046:   text-decoration: none;
                   6047:   color: $font;
                   6048: }
1.795     www      6049: 
1.397     albertel 6050: table#LC_helpmenu_links a:hover {
                   6051:   text-decoration: underline;
                   6052:   color: $vlink;
                   6053: }
1.396     albertel 6054: 
1.417     albertel 6055: .LC_chrt_popup_exists {
                   6056:   border: 1px solid #339933;
                   6057:   margin: -1px;
                   6058: }
1.795     www      6059: 
1.417     albertel 6060: .LC_chrt_popup_up {
                   6061:   border: 1px solid yellow;
                   6062:   margin: -1px;
                   6063: }
1.795     www      6064: 
1.417     albertel 6065: .LC_chrt_popup {
                   6066:   border: 1px solid #8888FF;
                   6067:   background: #CCCCFF;
                   6068: }
1.795     www      6069: 
1.421     albertel 6070: table.LC_pick_box {
                   6071:   border-collapse: separate;
                   6072:   background: white;
                   6073:   border: 1px solid black;
                   6074:   border-spacing: 1px;
                   6075: }
1.795     www      6076: 
1.421     albertel 6077: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6078:   background: $sidebg;
1.421     albertel 6079:   font-weight: bold;
1.900     bisitz   6080:   text-align: left;
1.740     bisitz   6081:   vertical-align: top;
1.421     albertel 6082:   width: 184px;
                   6083:   padding: 8px;
                   6084: }
1.795     www      6085: 
1.579     raeburn  6086: table.LC_pick_box td.LC_pick_box_value {
                   6087:   text-align: left;
                   6088:   padding: 8px;
                   6089: }
1.795     www      6090: 
1.579     raeburn  6091: table.LC_pick_box td.LC_pick_box_select {
                   6092:   text-align: left;
                   6093:   padding: 8px;
                   6094: }
1.795     www      6095: 
1.424     albertel 6096: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6097:   padding: 0;
1.421     albertel 6098:   height: 1px;
                   6099:   background: black;
                   6100: }
1.795     www      6101: 
1.421     albertel 6102: table.LC_pick_box td.LC_pick_box_submit {
                   6103:   text-align: right;
                   6104: }
1.795     www      6105: 
1.579     raeburn  6106: table.LC_pick_box td.LC_evenrow_value {
                   6107:   text-align: left;
                   6108:   padding: 8px;
                   6109:   background-color: $data_table_light;
                   6110: }
1.795     www      6111: 
1.579     raeburn  6112: table.LC_pick_box td.LC_oddrow_value {
                   6113:   text-align: left;
                   6114:   padding: 8px;
                   6115:   background-color: $data_table_light;
                   6116: }
1.795     www      6117: 
1.579     raeburn  6118: span.LC_helpform_receipt_cat {
                   6119:   font-weight: bold;
                   6120: }
1.795     www      6121: 
1.424     albertel 6122: table.LC_group_priv_box {
                   6123:   background: white;
                   6124:   border: 1px solid black;
                   6125:   border-spacing: 1px;
                   6126: }
1.795     www      6127: 
1.424     albertel 6128: table.LC_group_priv_box td.LC_pick_box_title {
                   6129:   background: $tabbg;
                   6130:   font-weight: bold;
                   6131:   text-align: right;
                   6132:   width: 184px;
                   6133: }
1.795     www      6134: 
1.424     albertel 6135: table.LC_group_priv_box td.LC_groups_fixed {
                   6136:   background: $data_table_light;
                   6137:   text-align: center;
                   6138: }
1.795     www      6139: 
1.424     albertel 6140: table.LC_group_priv_box td.LC_groups_optional {
                   6141:   background: $data_table_dark;
                   6142:   text-align: center;
                   6143: }
1.795     www      6144: 
1.424     albertel 6145: table.LC_group_priv_box td.LC_groups_functionality {
                   6146:   background: $data_table_darker;
                   6147:   text-align: center;
                   6148:   font-weight: bold;
                   6149: }
1.795     www      6150: 
1.424     albertel 6151: table.LC_group_priv td {
                   6152:   text-align: left;
1.803     bisitz   6153:   padding: 0;
1.424     albertel 6154: }
                   6155: 
                   6156: .LC_navbuttons {
                   6157:   margin: 2ex 0ex 2ex 0ex;
                   6158: }
1.795     www      6159: 
1.423     albertel 6160: .LC_topic_bar {
                   6161:   font-weight: bold;
                   6162:   background: $tabbg;
1.918     wenzelju 6163:   margin: 1em 0em 1em 2em;
1.805     bisitz   6164:   padding: 3px;
1.918     wenzelju 6165:   font-size: 1.2em;
1.423     albertel 6166: }
1.795     www      6167: 
1.423     albertel 6168: .LC_topic_bar span {
1.918     wenzelju 6169:   left: 0.5em;
                   6170:   position: absolute;
1.423     albertel 6171:   vertical-align: middle;
1.918     wenzelju 6172:   font-size: 1.2em;
1.423     albertel 6173: }
1.795     www      6174: 
1.423     albertel 6175: table.LC_course_group_status {
                   6176:   margin: 20px;
                   6177: }
1.795     www      6178: 
1.423     albertel 6179: table.LC_status_selector td {
                   6180:   vertical-align: top;
                   6181:   text-align: center;
1.424     albertel 6182:   padding: 4px;
                   6183: }
1.795     www      6184: 
1.599     albertel 6185: div.LC_feedback_link {
1.616     albertel 6186:   clear: both;
1.829     kalberla 6187:   background: $sidebg;
1.779     bisitz   6188:   width: 100%;
1.829     kalberla 6189:   padding-bottom: 10px;
                   6190:   border: 1px $tabbg solid;
1.833     kalberla 6191:   height: 22px;
                   6192:   line-height: 22px;
                   6193:   padding-top: 5px;
                   6194: }
                   6195: 
                   6196: div.LC_feedback_link img {
                   6197:   height: 22px;
1.867     kalberla 6198:   vertical-align:middle;
1.829     kalberla 6199: }
                   6200: 
1.911     bisitz   6201: div.LC_feedback_link a {
1.829     kalberla 6202:   text-decoration: none;
1.489     raeburn  6203: }
1.795     www      6204: 
1.867     kalberla 6205: div.LC_comblock {
1.911     bisitz   6206:   display:inline;
1.867     kalberla 6207:   color:$font;
                   6208:   font-size:90%;
                   6209: }
                   6210: 
                   6211: div.LC_feedback_link div.LC_comblock {
                   6212:   padding-left:5px;
                   6213: }
                   6214: 
                   6215: div.LC_feedback_link div.LC_comblock a {
                   6216:   color:$font;
                   6217: }
                   6218: 
1.489     raeburn  6219: span.LC_feedback_link {
1.858     bisitz   6220:   /* background: $feedback_link_bg; */
1.599     albertel 6221:   font-size: larger;
                   6222: }
1.795     www      6223: 
1.599     albertel 6224: span.LC_message_link {
1.858     bisitz   6225:   /* background: $feedback_link_bg; */
1.599     albertel 6226:   font-size: larger;
                   6227:   position: absolute;
                   6228:   right: 1em;
1.489     raeburn  6229: }
1.421     albertel 6230: 
1.515     albertel 6231: table.LC_prior_tries {
1.524     albertel 6232:   border: 1px solid #000000;
                   6233:   border-collapse: separate;
                   6234:   border-spacing: 1px;
1.515     albertel 6235: }
1.523     albertel 6236: 
1.515     albertel 6237: table.LC_prior_tries td {
1.524     albertel 6238:   padding: 2px;
1.515     albertel 6239: }
1.523     albertel 6240: 
                   6241: .LC_answer_correct {
1.795     www      6242:   background: lightgreen;
                   6243:   color: darkgreen;
                   6244:   padding: 6px;
1.523     albertel 6245: }
1.795     www      6246: 
1.523     albertel 6247: .LC_answer_charged_try {
1.797     www      6248:   background: #FFAAAA;
1.795     www      6249:   color: darkred;
                   6250:   padding: 6px;
1.523     albertel 6251: }
1.795     www      6252: 
1.779     bisitz   6253: .LC_answer_not_charged_try,
1.523     albertel 6254: .LC_answer_no_grade,
                   6255: .LC_answer_late {
1.795     www      6256:   background: lightyellow;
1.523     albertel 6257:   color: black;
1.795     www      6258:   padding: 6px;
1.523     albertel 6259: }
1.795     www      6260: 
1.523     albertel 6261: .LC_answer_previous {
1.795     www      6262:   background: lightblue;
                   6263:   color: darkblue;
                   6264:   padding: 6px;
1.523     albertel 6265: }
1.795     www      6266: 
1.779     bisitz   6267: .LC_answer_no_message {
1.777     tempelho 6268:   background: #FFFFFF;
                   6269:   color: black;
1.795     www      6270:   padding: 6px;
1.779     bisitz   6271: }
1.795     www      6272: 
1.779     bisitz   6273: .LC_answer_unknown {
                   6274:   background: orange;
                   6275:   color: black;
1.795     www      6276:   padding: 6px;
1.777     tempelho 6277: }
1.795     www      6278: 
1.529     albertel 6279: span.LC_prior_numerical,
                   6280: span.LC_prior_string,
                   6281: span.LC_prior_custom,
                   6282: span.LC_prior_reaction,
                   6283: span.LC_prior_math {
1.925     bisitz   6284:   font-family: $mono;
1.523     albertel 6285:   white-space: pre;
                   6286: }
                   6287: 
1.525     albertel 6288: span.LC_prior_string {
1.925     bisitz   6289:   font-family: $mono;
1.525     albertel 6290:   white-space: pre;
                   6291: }
                   6292: 
1.523     albertel 6293: table.LC_prior_option {
                   6294:   width: 100%;
                   6295:   border-collapse: collapse;
                   6296: }
1.795     www      6297: 
1.911     bisitz   6298: table.LC_prior_rank,
1.795     www      6299: table.LC_prior_match {
1.528     albertel 6300:   border-collapse: collapse;
                   6301: }
1.795     www      6302: 
1.528     albertel 6303: table.LC_prior_option tr td,
                   6304: table.LC_prior_rank tr td,
                   6305: table.LC_prior_match tr td {
1.524     albertel 6306:   border: 1px solid #000000;
1.515     albertel 6307: }
                   6308: 
1.855     bisitz   6309: .LC_nobreak {
1.544     albertel 6310:   white-space: nowrap;
1.519     raeburn  6311: }
                   6312: 
1.576     raeburn  6313: span.LC_cusr_emph {
                   6314:   font-style: italic;
                   6315: }
                   6316: 
1.633     raeburn  6317: span.LC_cusr_subheading {
                   6318:   font-weight: normal;
                   6319:   font-size: 85%;
                   6320: }
                   6321: 
1.861     bisitz   6322: div.LC_docs_entry_move {
1.859     bisitz   6323:   border: 1px solid #BBBBBB;
1.545     albertel 6324:   background: #DDDDDD;
1.861     bisitz   6325:   width: 22px;
1.859     bisitz   6326:   padding: 1px;
                   6327:   margin: 0;
1.545     albertel 6328: }
                   6329: 
1.861     bisitz   6330: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6331: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6332:   font-size: x-small;
                   6333: }
1.795     www      6334: 
1.861     bisitz   6335: .LC_docs_entry_parameter {
                   6336:   white-space: nowrap;
                   6337: }
                   6338: 
1.544     albertel 6339: .LC_docs_copy {
1.545     albertel 6340:   color: #000099;
1.544     albertel 6341: }
1.795     www      6342: 
1.544     albertel 6343: .LC_docs_cut {
1.545     albertel 6344:   color: #550044;
1.544     albertel 6345: }
1.795     www      6346: 
1.544     albertel 6347: .LC_docs_rename {
1.545     albertel 6348:   color: #009900;
1.544     albertel 6349: }
1.795     www      6350: 
1.544     albertel 6351: .LC_docs_remove {
1.545     albertel 6352:   color: #990000;
                   6353: }
                   6354: 
1.547     albertel 6355: .LC_docs_reinit_warn,
                   6356: .LC_docs_ext_edit {
                   6357:   font-size: x-small;
                   6358: }
                   6359: 
1.545     albertel 6360: table.LC_docs_adddocs td,
                   6361: table.LC_docs_adddocs th {
                   6362:   border: 1px solid #BBBBBB;
                   6363:   padding: 4px;
                   6364:   background: #DDDDDD;
1.543     albertel 6365: }
                   6366: 
1.584     albertel 6367: table.LC_sty_begin {
                   6368:   background: #BBFFBB;
                   6369: }
1.795     www      6370: 
1.584     albertel 6371: table.LC_sty_end {
                   6372:   background: #FFBBBB;
                   6373: }
                   6374: 
1.589     raeburn  6375: table.LC_double_column {
1.803     bisitz   6376:   border-width: 0;
1.589     raeburn  6377:   border-collapse: collapse;
                   6378:   width: 100%;
                   6379:   padding: 2px;
                   6380: }
                   6381: 
                   6382: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6383:   top: 2px;
1.589     raeburn  6384:   left: 2px;
                   6385:   width: 47%;
                   6386:   vertical-align: top;
                   6387: }
                   6388: 
                   6389: table.LC_double_column tr td.LC_right_col {
                   6390:   top: 2px;
1.779     bisitz   6391:   right: 2px;
1.589     raeburn  6392:   width: 47%;
                   6393:   vertical-align: top;
                   6394: }
                   6395: 
1.591     raeburn  6396: div.LC_left_float {
                   6397:   float: left;
                   6398:   padding-right: 5%;
1.597     albertel 6399:   padding-bottom: 4px;
1.591     raeburn  6400: }
                   6401: 
                   6402: div.LC_clear_float_header {
1.597     albertel 6403:   padding-bottom: 2px;
1.591     raeburn  6404: }
                   6405: 
                   6406: div.LC_clear_float_footer {
1.597     albertel 6407:   padding-top: 10px;
1.591     raeburn  6408:   clear: both;
                   6409: }
                   6410: 
1.597     albertel 6411: div.LC_grade_show_user {
1.941     bisitz   6412: /*  border-left: 5px solid $sidebg; */
                   6413:   border-top: 5px solid #000000;
                   6414:   margin: 50px 0 0 0;
1.936     bisitz   6415:   padding: 15px 0 5px 10px;
1.597     albertel 6416: }
1.795     www      6417: 
1.936     bisitz   6418: div.LC_grade_show_user_odd_row {
1.941     bisitz   6419: /*  border-left: 5px solid #000000; */
                   6420: }
                   6421: 
                   6422: div.LC_grade_show_user div.LC_Box {
                   6423:   margin-right: 50px;
1.597     albertel 6424: }
                   6425: 
                   6426: div.LC_grade_submissions,
                   6427: div.LC_grade_message_center,
1.936     bisitz   6428: div.LC_grade_info_links {
1.597     albertel 6429:   margin: 5px;
                   6430:   width: 99%;
                   6431:   background: #FFFFFF;
                   6432: }
1.795     www      6433: 
1.597     albertel 6434: div.LC_grade_submissions_header,
1.936     bisitz   6435: div.LC_grade_message_center_header {
1.705     tempelho 6436:   font-weight: bold;
                   6437:   font-size: large;
1.597     albertel 6438: }
1.795     www      6439: 
1.597     albertel 6440: div.LC_grade_submissions_body,
1.936     bisitz   6441: div.LC_grade_message_center_body {
1.597     albertel 6442:   border: 1px solid black;
                   6443:   width: 99%;
                   6444:   background: #FFFFFF;
                   6445: }
1.795     www      6446: 
1.613     albertel 6447: table.LC_scantron_action {
                   6448:   width: 100%;
                   6449: }
1.795     www      6450: 
1.613     albertel 6451: table.LC_scantron_action tr th {
1.698     harmsja  6452:   font-weight:bold;
                   6453:   font-style:normal;
1.613     albertel 6454: }
1.795     www      6455: 
1.779     bisitz   6456: .LC_edit_problem_header,
1.614     albertel 6457: div.LC_edit_problem_footer {
1.705     tempelho 6458:   font-weight: normal;
                   6459:   font-size:  medium;
1.602     albertel 6460:   margin: 2px;
1.1060    bisitz   6461:   background-color: $sidebg;
1.600     albertel 6462: }
1.795     www      6463: 
1.600     albertel 6464: div.LC_edit_problem_header,
1.602     albertel 6465: div.LC_edit_problem_header div,
1.614     albertel 6466: div.LC_edit_problem_footer,
                   6467: div.LC_edit_problem_footer div,
1.602     albertel 6468: div.LC_edit_problem_editxml_header,
                   6469: div.LC_edit_problem_editxml_header div {
1.600     albertel 6470:   margin-top: 5px;
                   6471: }
1.795     www      6472: 
1.600     albertel 6473: div.LC_edit_problem_header_title {
1.705     tempelho 6474:   font-weight: bold;
                   6475:   font-size: larger;
1.602     albertel 6476:   background: $tabbg;
                   6477:   padding: 3px;
1.1060    bisitz   6478:   margin: 0 0 5px 0;
1.602     albertel 6479: }
1.795     www      6480: 
1.602     albertel 6481: table.LC_edit_problem_header_title {
                   6482:   width: 100%;
1.600     albertel 6483:   background: $tabbg;
1.602     albertel 6484: }
                   6485: 
                   6486: div.LC_edit_problem_discards {
                   6487:   float: left;
                   6488:   padding-bottom: 5px;
                   6489: }
1.795     www      6490: 
1.602     albertel 6491: div.LC_edit_problem_saves {
                   6492:   float: right;
                   6493:   padding-bottom: 5px;
1.600     albertel 6494: }
1.795     www      6495: 
1.1124    bisitz   6496: .LC_edit_opt {
                   6497:   padding-left: 1em;
                   6498:   white-space: nowrap;
                   6499: }
                   6500: 
1.1152    golterma 6501: .LC_edit_problem_latexhelper{
                   6502:     text-align: right;
                   6503: }
                   6504: 
                   6505: #LC_edit_problem_colorful div{
                   6506:     margin-left: 40px;
                   6507: }
                   6508: 
1.911     bisitz   6509: img.stift {
1.803     bisitz   6510:   border-width: 0;
                   6511:   vertical-align: middle;
1.677     riegler  6512: }
1.680     riegler  6513: 
1.923     bisitz   6514: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6515:   vertical-align: top;
1.777     tempelho 6516: }
1.795     www      6517: 
1.716     raeburn  6518: div.LC_createcourse {
1.911     bisitz   6519:   margin: 10px 10px 10px 10px;
1.716     raeburn  6520: }
                   6521: 
1.917     raeburn  6522: .LC_dccid {
1.1130    raeburn  6523:   float: right;
1.917     raeburn  6524:   margin: 0.2em 0 0 0;
                   6525:   padding: 0;
                   6526:   font-size: 90%;
                   6527:   display:none;
                   6528: }
                   6529: 
1.897     wenzelju 6530: ol.LC_primary_menu a:hover,
1.721     harmsja  6531: ol#LC_MenuBreadcrumbs a:hover,
                   6532: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6533: ul#LC_secondary_menu a:hover,
1.721     harmsja  6534: .LC_FormSectionClearButton input:hover
1.795     www      6535: ul.LC_TabContent   li:hover a {
1.952     onken    6536:   color:$button_hover;
1.911     bisitz   6537:   text-decoration:none;
1.693     droeschl 6538: }
                   6539: 
1.779     bisitz   6540: h1 {
1.911     bisitz   6541:   padding: 0;
                   6542:   line-height:130%;
1.693     droeschl 6543: }
1.698     harmsja  6544: 
1.911     bisitz   6545: h2,
                   6546: h3,
                   6547: h4,
                   6548: h5,
                   6549: h6 {
                   6550:   margin: 5px 0 5px 0;
                   6551:   padding: 0;
                   6552:   line-height:130%;
1.693     droeschl 6553: }
1.795     www      6554: 
                   6555: .LC_hcell {
1.911     bisitz   6556:   padding:3px 15px 3px 15px;
                   6557:   margin: 0;
                   6558:   background-color:$tabbg;
                   6559:   color:$fontmenu;
                   6560:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6561: }
1.795     www      6562: 
1.840     bisitz   6563: .LC_Box > .LC_hcell {
1.911     bisitz   6564:   margin: 0 -10px 10px -10px;
1.835     bisitz   6565: }
                   6566: 
1.721     harmsja  6567: .LC_noBorder {
1.911     bisitz   6568:   border: 0;
1.698     harmsja  6569: }
1.693     droeschl 6570: 
1.721     harmsja  6571: .LC_FormSectionClearButton input {
1.911     bisitz   6572:   background-color:transparent;
                   6573:   border: none;
                   6574:   cursor:pointer;
                   6575:   text-decoration:underline;
1.693     droeschl 6576: }
1.763     bisitz   6577: 
                   6578: .LC_help_open_topic {
1.911     bisitz   6579:   color: #FFFFFF;
                   6580:   background-color: #EEEEFF;
                   6581:   margin: 1px;
                   6582:   padding: 4px;
                   6583:   border: 1px solid #000033;
                   6584:   white-space: nowrap;
                   6585:   /* vertical-align: middle; */
1.759     neumanie 6586: }
1.693     droeschl 6587: 
1.911     bisitz   6588: dl,
                   6589: ul,
                   6590: div,
                   6591: fieldset {
                   6592:   margin: 10px 10px 10px 0;
                   6593:   /* overflow: hidden; */
1.693     droeschl 6594: }
1.795     www      6595: 
1.838     bisitz   6596: fieldset > legend {
1.911     bisitz   6597:   font-weight: bold;
                   6598:   padding: 0 5px 0 5px;
1.838     bisitz   6599: }
                   6600: 
1.813     bisitz   6601: #LC_nav_bar {
1.911     bisitz   6602:   float: left;
1.995     raeburn  6603:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6604:   margin: 0 0 2px 0;
1.807     droeschl 6605: }
                   6606: 
1.916     droeschl 6607: #LC_realm {
                   6608:   margin: 0.2em 0 0 0;
                   6609:   padding: 0;
                   6610:   font-weight: bold;
                   6611:   text-align: center;
1.995     raeburn  6612:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6613: }
                   6614: 
1.911     bisitz   6615: #LC_nav_bar em {
                   6616:   font-weight: bold;
                   6617:   font-style: normal;
1.807     droeschl 6618: }
                   6619: 
1.897     wenzelju 6620: ol.LC_primary_menu {
1.934     droeschl 6621:   margin: 0;
1.1076    raeburn  6622:   padding: 0;
1.995     raeburn  6623:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6624: }
                   6625: 
1.852     droeschl 6626: ol#LC_PathBreadcrumbs {
1.911     bisitz   6627:   margin: 0;
1.693     droeschl 6628: }
                   6629: 
1.897     wenzelju 6630: ol.LC_primary_menu li {
1.1076    raeburn  6631:   color: RGB(80, 80, 80);
                   6632:   vertical-align: middle;
                   6633:   text-align: left;
                   6634:   list-style: none;
                   6635:   float: left;
                   6636: }
                   6637: 
                   6638: ol.LC_primary_menu li a {
                   6639:   display: block;
                   6640:   margin: 0;
                   6641:   padding: 0 5px 0 10px;
                   6642:   text-decoration: none;
                   6643: }
                   6644: 
                   6645: ol.LC_primary_menu li ul {
                   6646:   display: none;
                   6647:   width: 10em;
                   6648:   background-color: $data_table_light;
                   6649: }
                   6650: 
                   6651: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6652:   display: block;
                   6653:   position: absolute;
                   6654:   margin: 0;
                   6655:   padding: 0;
1.1078    raeburn  6656:   z-index: 2;
1.1076    raeburn  6657: }
                   6658: 
                   6659: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6660:   font-size: 90%;
1.911     bisitz   6661:   vertical-align: top;
1.1076    raeburn  6662:   float: none;
1.1079    raeburn  6663:   border-left: 1px solid black;
                   6664:   border-right: 1px solid black;
1.1076    raeburn  6665: }
                   6666: 
                   6667: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1078    raeburn  6668:   background-color:$data_table_light;
1.1076    raeburn  6669: }
                   6670: 
                   6671: ol.LC_primary_menu li li a:hover {
                   6672:    color:$button_hover;
                   6673:    background-color:$data_table_dark;
1.693     droeschl 6674: }
                   6675: 
1.897     wenzelju 6676: ol.LC_primary_menu li img {
1.911     bisitz   6677:   vertical-align: bottom;
1.934     droeschl 6678:   height: 1.1em;
1.1077    raeburn  6679:   margin: 0.2em 0 0 0;
1.693     droeschl 6680: }
                   6681: 
1.897     wenzelju 6682: ol.LC_primary_menu a {
1.911     bisitz   6683:   color: RGB(80, 80, 80);
                   6684:   text-decoration: none;
1.693     droeschl 6685: }
1.795     www      6686: 
1.949     droeschl 6687: ol.LC_primary_menu a.LC_new_message {
                   6688:   font-weight:bold;
                   6689:   color: darkred;
                   6690: }
                   6691: 
1.975     raeburn  6692: ol.LC_docs_parameters {
                   6693:   margin-left: 0;
                   6694:   padding: 0;
                   6695:   list-style: none;
                   6696: }
                   6697: 
                   6698: ol.LC_docs_parameters li {
                   6699:   margin: 0;
                   6700:   padding-right: 20px;
                   6701:   display: inline;
                   6702: }
                   6703: 
1.976     raeburn  6704: ol.LC_docs_parameters li:before {
                   6705:   content: "\\002022 \\0020";
                   6706: }
                   6707: 
                   6708: li.LC_docs_parameters_title {
                   6709:   font-weight: bold;
                   6710: }
                   6711: 
                   6712: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6713:   content: "";
                   6714: }
                   6715: 
1.897     wenzelju 6716: ul#LC_secondary_menu {
1.1107    raeburn  6717:   clear: right;
1.911     bisitz   6718:   color: $fontmenu;
                   6719:   background: $tabbg;
                   6720:   list-style: none;
                   6721:   padding: 0;
                   6722:   margin: 0;
                   6723:   width: 100%;
1.995     raeburn  6724:   text-align: left;
1.1107    raeburn  6725:   float: left;
1.808     droeschl 6726: }
                   6727: 
1.897     wenzelju 6728: ul#LC_secondary_menu li {
1.911     bisitz   6729:   font-weight: bold;
                   6730:   line-height: 1.8em;
1.1107    raeburn  6731:   border-right: 1px solid black;
                   6732:   float: left;
                   6733: }
                   6734: 
                   6735: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6736:   background-color: $data_table_light;
                   6737: }
                   6738: 
                   6739: ul#LC_secondary_menu li a {
1.911     bisitz   6740:   padding: 0 0.8em;
1.1107    raeburn  6741: }
                   6742: 
                   6743: ul#LC_secondary_menu li ul {
                   6744:   display: none;
                   6745: }
                   6746: 
                   6747: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6748:   display: block;
                   6749:   position: absolute;
                   6750:   margin: 0;
                   6751:   padding: 0;
                   6752:   list-style:none;
                   6753:   float: none;
                   6754:   background-color: $data_table_light;
                   6755:   z-index: 2;
                   6756:   margin-left: -1px;
                   6757: }
                   6758: 
                   6759: ul#LC_secondary_menu li ul li {
                   6760:   font-size: 90%;
                   6761:   vertical-align: top;
                   6762:   border-left: 1px solid black;
1.911     bisitz   6763:   border-right: 1px solid black;
1.1119    raeburn  6764:   background-color: $data_table_light;
1.1107    raeburn  6765:   list-style:none;
                   6766:   float: none;
                   6767: }
                   6768: 
                   6769: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6770:   background-color: $data_table_dark;
1.807     droeschl 6771: }
                   6772: 
1.847     tempelho 6773: ul.LC_TabContent {
1.911     bisitz   6774:   display:block;
                   6775:   background: $sidebg;
                   6776:   border-bottom: solid 1px $lg_border_color;
                   6777:   list-style:none;
1.1020    raeburn  6778:   margin: -1px -10px 0 -10px;
1.911     bisitz   6779:   padding: 0;
1.693     droeschl 6780: }
                   6781: 
1.795     www      6782: ul.LC_TabContent li,
                   6783: ul.LC_TabContentBigger li {
1.911     bisitz   6784:   float:left;
1.741     harmsja  6785: }
1.795     www      6786: 
1.897     wenzelju 6787: ul#LC_secondary_menu li a {
1.911     bisitz   6788:   color: $fontmenu;
                   6789:   text-decoration: none;
1.693     droeschl 6790: }
1.795     www      6791: 
1.721     harmsja  6792: ul.LC_TabContent {
1.952     onken    6793:   min-height:20px;
1.721     harmsja  6794: }
1.795     www      6795: 
                   6796: ul.LC_TabContent li {
1.911     bisitz   6797:   vertical-align:middle;
1.959     onken    6798:   padding: 0 16px 0 10px;
1.911     bisitz   6799:   background-color:$tabbg;
                   6800:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6801:   border-left: solid 1px $font;
1.721     harmsja  6802: }
1.795     www      6803: 
1.847     tempelho 6804: ul.LC_TabContent .right {
1.911     bisitz   6805:   float:right;
1.847     tempelho 6806: }
                   6807: 
1.911     bisitz   6808: ul.LC_TabContent li a,
                   6809: ul.LC_TabContent li {
                   6810:   color:rgb(47,47,47);
                   6811:   text-decoration:none;
                   6812:   font-size:95%;
                   6813:   font-weight:bold;
1.952     onken    6814:   min-height:20px;
                   6815: }
                   6816: 
1.959     onken    6817: ul.LC_TabContent li a:hover,
                   6818: ul.LC_TabContent li a:focus {
1.952     onken    6819:   color: $button_hover;
1.959     onken    6820:   background:none;
                   6821:   outline:none;
1.952     onken    6822: }
                   6823: 
                   6824: ul.LC_TabContent li:hover {
                   6825:   color: $button_hover;
                   6826:   cursor:pointer;
1.721     harmsja  6827: }
1.795     www      6828: 
1.911     bisitz   6829: ul.LC_TabContent li.active {
1.952     onken    6830:   color: $font;
1.911     bisitz   6831:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6832:   border-bottom:solid 1px #FFFFFF;
                   6833:   cursor: default;
1.744     ehlerst  6834: }
1.795     www      6835: 
1.959     onken    6836: ul.LC_TabContent li.active a {
                   6837:   color:$font;
                   6838:   background:#FFFFFF;
                   6839:   outline: none;
                   6840: }
1.1047    raeburn  6841: 
                   6842: ul.LC_TabContent li.goback {
                   6843:   float: left;
                   6844:   border-left: none;
                   6845: }
                   6846: 
1.870     tempelho 6847: #maincoursedoc {
1.911     bisitz   6848:   clear:both;
1.870     tempelho 6849: }
                   6850: 
                   6851: ul.LC_TabContentBigger {
1.911     bisitz   6852:   display:block;
                   6853:   list-style:none;
                   6854:   padding: 0;
1.870     tempelho 6855: }
                   6856: 
1.795     www      6857: ul.LC_TabContentBigger li {
1.911     bisitz   6858:   vertical-align:bottom;
                   6859:   height: 30px;
                   6860:   font-size:110%;
                   6861:   font-weight:bold;
                   6862:   color: #737373;
1.841     tempelho 6863: }
                   6864: 
1.957     onken    6865: ul.LC_TabContentBigger li.active {
                   6866:   position: relative;
                   6867:   top: 1px;
                   6868: }
                   6869: 
1.870     tempelho 6870: ul.LC_TabContentBigger li a {
1.911     bisitz   6871:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6872:   height: 30px;
                   6873:   line-height: 30px;
                   6874:   text-align: center;
                   6875:   display: block;
                   6876:   text-decoration: none;
1.958     onken    6877:   outline: none;  
1.741     harmsja  6878: }
1.795     www      6879: 
1.870     tempelho 6880: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6881:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6882:   color:$font;
1.744     ehlerst  6883: }
1.795     www      6884: 
1.870     tempelho 6885: ul.LC_TabContentBigger li b {
1.911     bisitz   6886:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6887:   display: block;
                   6888:   float: left;
                   6889:   padding: 0 30px;
1.957     onken    6890:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6891: }
                   6892: 
1.956     onken    6893: ul.LC_TabContentBigger li:hover b {
                   6894:   color:$button_hover;
                   6895: }
                   6896: 
1.870     tempelho 6897: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6898:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6899:   color:$font;
1.957     onken    6900:   border: 0;
1.741     harmsja  6901: }
1.693     droeschl 6902: 
1.870     tempelho 6903: 
1.862     bisitz   6904: ul.LC_CourseBreadcrumbs {
                   6905:   background: $sidebg;
1.1020    raeburn  6906:   height: 2em;
1.862     bisitz   6907:   padding-left: 10px;
1.1020    raeburn  6908:   margin: 0;
1.862     bisitz   6909:   list-style-position: inside;
                   6910: }
                   6911: 
1.911     bisitz   6912: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6913: ol#LC_PathBreadcrumbs {
1.911     bisitz   6914:   padding-left: 10px;
                   6915:   margin: 0;
1.933     droeschl 6916:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6917: }
                   6918: 
1.911     bisitz   6919: ol#LC_MenuBreadcrumbs li,
                   6920: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6921: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6922:   display: inline;
1.933     droeschl 6923:   white-space: normal;  
1.693     droeschl 6924: }
                   6925: 
1.823     bisitz   6926: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6927: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6928:   text-decoration: none;
                   6929:   font-size:90%;
1.693     droeschl 6930: }
1.795     www      6931: 
1.969     droeschl 6932: ol#LC_MenuBreadcrumbs h1 {
                   6933:   display: inline;
                   6934:   font-size: 90%;
                   6935:   line-height: 2.5em;
                   6936:   margin: 0;
                   6937:   padding: 0;
                   6938: }
                   6939: 
1.795     www      6940: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6941:   text-decoration:none;
                   6942:   font-size:100%;
                   6943:   font-weight:bold;
1.693     droeschl 6944: }
1.795     www      6945: 
1.840     bisitz   6946: .LC_Box {
1.911     bisitz   6947:   border: solid 1px $lg_border_color;
                   6948:   padding: 0 10px 10px 10px;
1.746     neumanie 6949: }
1.795     www      6950: 
1.1020    raeburn  6951: .LC_DocsBox {
                   6952:   border: solid 1px $lg_border_color;
                   6953:   padding: 0 0 10px 10px;
                   6954: }
                   6955: 
1.795     www      6956: .LC_AboutMe_Image {
1.911     bisitz   6957:   float:left;
                   6958:   margin-right:10px;
1.747     neumanie 6959: }
1.795     www      6960: 
                   6961: .LC_Clear_AboutMe_Image {
1.911     bisitz   6962:   clear:left;
1.747     neumanie 6963: }
1.795     www      6964: 
1.721     harmsja  6965: dl.LC_ListStyleClean dt {
1.911     bisitz   6966:   padding-right: 5px;
                   6967:   display: table-header-group;
1.693     droeschl 6968: }
                   6969: 
1.721     harmsja  6970: dl.LC_ListStyleClean dd {
1.911     bisitz   6971:   display: table-row;
1.693     droeschl 6972: }
                   6973: 
1.721     harmsja  6974: .LC_ListStyleClean,
                   6975: .LC_ListStyleSimple,
                   6976: .LC_ListStyleNormal,
1.795     www      6977: .LC_ListStyleSpecial {
1.911     bisitz   6978:   /* display:block; */
                   6979:   list-style-position: inside;
                   6980:   list-style-type: none;
                   6981:   overflow: hidden;
                   6982:   padding: 0;
1.693     droeschl 6983: }
                   6984: 
1.721     harmsja  6985: .LC_ListStyleSimple li,
                   6986: .LC_ListStyleSimple dd,
                   6987: .LC_ListStyleNormal li,
                   6988: .LC_ListStyleNormal dd,
                   6989: .LC_ListStyleSpecial li,
1.795     www      6990: .LC_ListStyleSpecial dd {
1.911     bisitz   6991:   margin: 0;
                   6992:   padding: 5px 5px 5px 10px;
                   6993:   clear: both;
1.693     droeschl 6994: }
                   6995: 
1.721     harmsja  6996: .LC_ListStyleClean li,
                   6997: .LC_ListStyleClean dd {
1.911     bisitz   6998:   padding-top: 0;
                   6999:   padding-bottom: 0;
1.693     droeschl 7000: }
                   7001: 
1.721     harmsja  7002: .LC_ListStyleSimple dd,
1.795     www      7003: .LC_ListStyleSimple li {
1.911     bisitz   7004:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7005: }
                   7006: 
1.721     harmsja  7007: .LC_ListStyleSpecial li,
                   7008: .LC_ListStyleSpecial dd {
1.911     bisitz   7009:   list-style-type: none;
                   7010:   background-color: RGB(220, 220, 220);
                   7011:   margin-bottom: 4px;
1.693     droeschl 7012: }
                   7013: 
1.721     harmsja  7014: table.LC_SimpleTable {
1.911     bisitz   7015:   margin:5px;
                   7016:   border:solid 1px $lg_border_color;
1.795     www      7017: }
1.693     droeschl 7018: 
1.721     harmsja  7019: table.LC_SimpleTable tr {
1.911     bisitz   7020:   padding: 0;
                   7021:   border:solid 1px $lg_border_color;
1.693     droeschl 7022: }
1.795     www      7023: 
                   7024: table.LC_SimpleTable thead {
1.911     bisitz   7025:   background:rgb(220,220,220);
1.693     droeschl 7026: }
                   7027: 
1.721     harmsja  7028: div.LC_columnSection {
1.911     bisitz   7029:   display: block;
                   7030:   clear: both;
                   7031:   overflow: hidden;
                   7032:   margin: 0;
1.693     droeschl 7033: }
                   7034: 
1.721     harmsja  7035: div.LC_columnSection>* {
1.911     bisitz   7036:   float: left;
                   7037:   margin: 10px 20px 10px 0;
                   7038:   overflow:hidden;
1.693     droeschl 7039: }
1.721     harmsja  7040: 
1.795     www      7041: table em {
1.911     bisitz   7042:   font-weight: bold;
                   7043:   font-style: normal;
1.748     schulted 7044: }
1.795     www      7045: 
1.779     bisitz   7046: table.LC_tableBrowseRes,
1.795     www      7047: table.LC_tableOfContent {
1.911     bisitz   7048:   border:none;
                   7049:   border-spacing: 1px;
                   7050:   padding: 3px;
                   7051:   background-color: #FFFFFF;
                   7052:   font-size: 90%;
1.753     droeschl 7053: }
1.789     droeschl 7054: 
1.911     bisitz   7055: table.LC_tableOfContent {
                   7056:   border-collapse: collapse;
1.789     droeschl 7057: }
                   7058: 
1.771     droeschl 7059: table.LC_tableBrowseRes a,
1.768     schulted 7060: table.LC_tableOfContent a {
1.911     bisitz   7061:   background-color: transparent;
                   7062:   text-decoration: none;
1.753     droeschl 7063: }
                   7064: 
1.795     www      7065: table.LC_tableOfContent img {
1.911     bisitz   7066:   border: none;
                   7067:   height: 1.3em;
                   7068:   vertical-align: text-bottom;
                   7069:   margin-right: 0.3em;
1.753     droeschl 7070: }
1.757     schulted 7071: 
1.795     www      7072: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7073:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7074: }
                   7075: 
1.795     www      7076: a#LC_content_toolbar_everything {
1.911     bisitz   7077:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7078: }
                   7079: 
1.795     www      7080: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7081:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7082: }
                   7083: 
1.795     www      7084: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7085:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7086: }
                   7087: 
1.795     www      7088: a#LC_content_toolbar_changefolder {
1.911     bisitz   7089:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7090: }
                   7091: 
1.795     www      7092: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7093:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7094: }
                   7095: 
1.1043    raeburn  7096: a#LC_content_toolbar_edittoplevel {
                   7097:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7098: }
                   7099: 
1.795     www      7100: ul#LC_toolbar li a:hover {
1.911     bisitz   7101:   background-position: bottom center;
1.757     schulted 7102: }
                   7103: 
1.795     www      7104: ul#LC_toolbar {
1.911     bisitz   7105:   padding: 0;
                   7106:   margin: 2px;
                   7107:   list-style:none;
                   7108:   position:relative;
                   7109:   background-color:white;
1.1082    raeburn  7110:   overflow: auto;
1.757     schulted 7111: }
                   7112: 
1.795     www      7113: ul#LC_toolbar li {
1.911     bisitz   7114:   border:1px solid white;
                   7115:   padding: 0;
                   7116:   margin: 0;
                   7117:   float: left;
                   7118:   display:inline;
                   7119:   vertical-align:middle;
1.1082    raeburn  7120:   white-space: nowrap;
1.911     bisitz   7121: }
1.757     schulted 7122: 
1.783     amueller 7123: 
1.795     www      7124: a.LC_toolbarItem {
1.911     bisitz   7125:   display:block;
                   7126:   padding: 0;
                   7127:   margin: 0;
                   7128:   height: 32px;
                   7129:   width: 32px;
                   7130:   color:white;
                   7131:   border: none;
                   7132:   background-repeat:no-repeat;
                   7133:   background-color:transparent;
1.757     schulted 7134: }
                   7135: 
1.915     droeschl 7136: ul.LC_funclist {
                   7137:     margin: 0;
                   7138:     padding: 0.5em 1em 0.5em 0;
                   7139: }
                   7140: 
1.933     droeschl 7141: ul.LC_funclist > li:first-child {
                   7142:     font-weight:bold; 
                   7143:     margin-left:0.8em;
                   7144: }
                   7145: 
1.915     droeschl 7146: ul.LC_funclist + ul.LC_funclist {
                   7147:     /* 
                   7148:        left border as a seperator if we have more than
                   7149:        one list 
                   7150:     */
                   7151:     border-left: 1px solid $sidebg;
                   7152:     /* 
                   7153:        this hides the left border behind the border of the 
                   7154:        outer box if element is wrapped to the next 'line' 
                   7155:     */
                   7156:     margin-left: -1px;
                   7157: }
                   7158: 
1.843     bisitz   7159: ul.LC_funclist li {
1.915     droeschl 7160:   display: inline;
1.782     bisitz   7161:   white-space: nowrap;
1.915     droeschl 7162:   margin: 0 0 0 25px;
                   7163:   line-height: 150%;
1.782     bisitz   7164: }
                   7165: 
1.974     wenzelju 7166: .LC_hidden {
                   7167:   display: none;
                   7168: }
                   7169: 
1.1030    www      7170: .LCmodal-overlay {
                   7171: 		position:fixed;
                   7172: 		top:0;
                   7173: 		right:0;
                   7174: 		bottom:0;
                   7175: 		left:0;
                   7176: 		height:100%;
                   7177: 		width:100%;
                   7178: 		margin:0;
                   7179: 		padding:0;
                   7180: 		background:#999;
                   7181: 		opacity:.75;
                   7182: 		filter: alpha(opacity=75);
                   7183: 		-moz-opacity: 0.75;
                   7184: 		z-index:101;
                   7185: }
                   7186: 
                   7187: * html .LCmodal-overlay {   
                   7188: 		position: absolute;
                   7189: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7190: }
                   7191: 
                   7192: .LCmodal-window {
                   7193: 		position:fixed;
                   7194: 		top:50%;
                   7195: 		left:50%;
                   7196: 		margin:0;
                   7197: 		padding:0;
                   7198: 		z-index:102;
                   7199: 	}
                   7200: 
                   7201: * html .LCmodal-window {
                   7202: 		position:absolute;
                   7203: }
                   7204: 
                   7205: .LCclose-window {
                   7206: 		position:absolute;
                   7207: 		width:32px;
                   7208: 		height:32px;
                   7209: 		right:8px;
                   7210: 		top:8px;
                   7211: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7212: 		text-indent:-99999px;
                   7213: 		overflow:hidden;
                   7214: 		cursor:pointer;
                   7215: }
                   7216: 
1.1100    raeburn  7217: /*
                   7218:   styles used by TTH when "Default set of options to pass to tth/m
                   7219:   when converting TeX" in course settings has been set
                   7220: 
                   7221:   option passed: -t
                   7222: 
                   7223: */
                   7224: 
                   7225: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7226: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7227: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7228: td div.norm {line-height:normal;}
                   7229: 
                   7230: /*
                   7231:   option passed -y3
                   7232: */
                   7233: 
                   7234: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7235: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7236: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7237: 
1.343     albertel 7238: END
                   7239: }
                   7240: 
1.306     albertel 7241: =pod
                   7242: 
                   7243: =item * &headtag()
                   7244: 
                   7245: Returns a uniform footer for LON-CAPA web pages.
                   7246: 
1.307     albertel 7247: Inputs: $title - optional title for the head
                   7248:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7249:         $args - optional arguments
1.319     albertel 7250:             force_register - if is true call registerurl so the remote is 
                   7251:                              informed
1.415     albertel 7252:             redirect       -> array ref of
                   7253:                                    1- seconds before redirect occurs
                   7254:                                    2- url to redirect to
                   7255:                                    3- whether the side effect should occur
1.315     albertel 7256:                            (side effect of setting 
                   7257:                                $env{'internal.head.redirect'} to the url 
                   7258:                                redirected too)
1.352     albertel 7259:             domain         -> force to color decorate a page for a specific
                   7260:                                domain
                   7261:             function       -> force usage of a specific rolish color scheme
                   7262:             bgcolor        -> override the default page bgcolor
1.460     albertel 7263:             no_auto_mt_title
                   7264:                            -> prevent &mt()ing the title arg
1.464     albertel 7265: 
1.306     albertel 7266: =cut
                   7267: 
                   7268: sub headtag {
1.313     albertel 7269:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7270:     
1.363     albertel 7271:     my $function = $args->{'function'} || &get_users_function();
                   7272:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7273:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1154    raeburn  7274:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7275:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7276: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7277: 		   #time(),
1.418     albertel 7278: 		   $env{'environment.color.timestamp'},
1.363     albertel 7279: 		   $function,$domain,$bgcolor);
                   7280: 
1.369     www      7281:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7282: 
1.308     albertel 7283:     my $result =
                   7284: 	'<head>'.
1.461     albertel 7285: 	&font_settings();
1.319     albertel 7286: 
1.1064    raeburn  7287:     my $inhibitprint = &print_suppression();
                   7288: 
1.461     albertel 7289:     if (!$args->{'frameset'}) {
                   7290: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7291:     }
1.962     droeschl 7292:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   7293:         $result .= Apache::lonxml::display_title();
1.319     albertel 7294:     }
1.436     albertel 7295:     if (!$args->{'no_nav_bar'} 
                   7296: 	&& !$args->{'only_body'}
                   7297: 	&& !$args->{'frameset'}) {
1.1154    raeburn  7298: 	$result .= &help_menu_js($httphost);
1.1032    www      7299:         $result.=&modal_window();
1.1038    www      7300:         $result.=&togglebox_script();
1.1034    www      7301:         $result.=&wishlist_window();
1.1041    www      7302:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7303:     } else {
                   7304:         if ($args->{'add_modal'}) {
                   7305:            $result.=&modal_window();
                   7306:         }
                   7307:         if ($args->{'add_wishlist'}) {
                   7308:            $result.=&wishlist_window();
                   7309:         }
1.1038    www      7310:         if ($args->{'add_togglebox'}) {
                   7311:            $result.=&togglebox_script();
                   7312:         }
1.1041    www      7313:         if ($args->{'add_progressbar'}) {
                   7314:            $result.=&LCprogressbarUpdate_script();
                   7315:         }
1.436     albertel 7316:     }
1.314     albertel 7317:     if (ref($args->{'redirect'})) {
1.414     albertel 7318: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7319: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7320: 	if (!$inhibit_continue) {
                   7321: 	    $env{'internal.head.redirect'} = $url;
                   7322: 	}
1.313     albertel 7323: 	$result.=<<ADDMETA
                   7324: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7325: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7326: ADDMETA
                   7327:     }
1.306     albertel 7328:     if (!defined($title)) {
                   7329: 	$title = 'The LearningOnline Network with CAPA';
                   7330:     }
1.460     albertel 7331:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7332:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 7333: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064    raeburn  7334:         .$inhibitprint
1.414     albertel 7335: 	.$head_extra;
1.1137    raeburn  7336:     if ($env{'browser.mobile'}) {
                   7337:         $result .= '
                   7338: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7339: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7340:     }
1.962     droeschl 7341:     return $result.'</head>';
1.306     albertel 7342: }
                   7343: 
                   7344: =pod
                   7345: 
1.340     albertel 7346: =item * &font_settings()
                   7347: 
                   7348: Returns neccessary <meta> to set the proper encoding
                   7349: 
                   7350: Inputs: none
                   7351: 
                   7352: =cut
                   7353: 
                   7354: sub font_settings {
                   7355:     my $headerstring='';
1.647     www      7356:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 7357: 	$headerstring.=
                   7358: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   7359:     }
                   7360:     return $headerstring;
                   7361: }
                   7362: 
1.341     albertel 7363: =pod
                   7364: 
1.1064    raeburn  7365: =item * &print_suppression()
                   7366: 
                   7367: In course context returns css which causes the body to be blank when media="print",
                   7368: if printout generation is unavailable for the current resource.
                   7369: 
                   7370: This could be because:
                   7371: 
                   7372: (a) printstartdate is in the future
                   7373: 
                   7374: (b) printenddate is in the past
                   7375: 
                   7376: (c) there is an active exam block with "printout"
                   7377: functionality blocked
                   7378: 
                   7379: Users with pav, pfo or evb privileges are exempt.
                   7380: 
                   7381: Inputs: none
                   7382: 
                   7383: =cut
                   7384: 
                   7385: 
                   7386: sub print_suppression {
                   7387:     my $noprint;
                   7388:     if ($env{'request.course.id'}) {
                   7389:         my $scope = $env{'request.course.id'};
                   7390:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7391:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7392:             return;
                   7393:         }
                   7394:         if ($env{'request.course.sec'} ne '') {
                   7395:             $scope .= "/$env{'request.course.sec'}";
                   7396:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7397:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7398:                 return;
1.1064    raeburn  7399:             }
                   7400:         }
                   7401:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7402:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7403:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7404:         if ($blocked) {
                   7405:             my $checkrole = "cm./$cdom/$cnum";
                   7406:             if ($env{'request.course.sec'} ne '') {
                   7407:                 $checkrole .= "/$env{'request.course.sec'}";
                   7408:             }
                   7409:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7410:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7411:                 $noprint = 1;
                   7412:             }
                   7413:         }
                   7414:         unless ($noprint) {
                   7415:             my $symb = &Apache::lonnet::symbread();
                   7416:             if ($symb ne '') {
                   7417:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7418:                 if (ref($navmap)) {
                   7419:                     my $res = $navmap->getBySymb($symb);
                   7420:                     if (ref($res)) {
                   7421:                         if (!$res->resprintable()) {
                   7422:                             $noprint = 1;
                   7423:                         }
                   7424:                     }
                   7425:                 }
                   7426:             }
                   7427:         }
                   7428:         if ($noprint) {
                   7429:             return <<"ENDSTYLE";
                   7430: <style type="text/css" media="print">
                   7431:     body { display:none }
                   7432: </style>
                   7433: ENDSTYLE
                   7434:         }
                   7435:     }
                   7436:     return;
                   7437: }
                   7438: 
                   7439: =pod
                   7440: 
1.341     albertel 7441: =item * &xml_begin()
                   7442: 
                   7443: Returns the needed doctype and <html>
                   7444: 
                   7445: Inputs: none
                   7446: 
                   7447: =cut
                   7448: 
                   7449: sub xml_begin {
                   7450:     my $output='';
                   7451: 
                   7452:     if ($env{'browser.mathml'}) {
                   7453: 	$output='<?xml version="1.0"?>'
                   7454:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7455: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7456:             
                   7457: #	    .'<!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">] >'
                   7458: 	    .'<!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">'
                   7459:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7460: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   7461:     } else {
1.849     bisitz   7462: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   7463:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 7464:     }
                   7465:     return $output;
                   7466: }
1.340     albertel 7467: 
                   7468: =pod
                   7469: 
1.306     albertel 7470: =item * &start_page()
                   7471: 
                   7472: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7473: 
1.648     raeburn  7474: Inputs:
                   7475: 
                   7476: =over 4
                   7477: 
                   7478: $title - optional title for the page
                   7479: 
                   7480: $head_extra - optional extra HTML to incude inside the <head>
                   7481: 
                   7482: $args - additional optional args supported are:
                   7483: 
                   7484: =over 8
                   7485: 
                   7486:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7487:                                     arg on
1.814     bisitz   7488:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7489:              add_entries    -> additional attributes to add to the  <body>
                   7490:              domain         -> force to color decorate a page for a 
1.317     albertel 7491:                                     specific domain
1.648     raeburn  7492:              function       -> force usage of a specific rolish color
1.317     albertel 7493:                                     scheme
1.648     raeburn  7494:              redirect       -> see &headtag()
                   7495:              bgcolor        -> override the default page bg color
                   7496:              js_ready       -> return a string ready for being used in 
1.317     albertel 7497:                                     a javascript writeln
1.648     raeburn  7498:              html_encode    -> return a string ready for being used in 
1.320     albertel 7499:                                     a html attribute
1.648     raeburn  7500:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7501:                                     $forcereg arg
1.648     raeburn  7502:              frameset       -> if true will start with a <frameset>
1.330     albertel 7503:                                     rather than <body>
1.648     raeburn  7504:              skip_phases    -> hash ref of 
1.338     albertel 7505:                                     head -> skip the <html><head> generation
                   7506:                                     body -> skip all <body> generation
1.648     raeburn  7507:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7508:              inherit_jsmath -> when creating popup window in a page,
                   7509:                                     should it have jsmath forced on by the
                   7510:                                     current page
1.867     kalberla 7511:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7512:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1096    raeburn  7513:              group          -> includes the current group, if page is for a 
                   7514:                                specific group  
1.361     albertel 7515: 
1.648     raeburn  7516: =back
1.460     albertel 7517: 
1.648     raeburn  7518: =back
1.562     albertel 7519: 
1.306     albertel 7520: =cut
                   7521: 
                   7522: sub start_page {
1.309     albertel 7523:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7524:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7525: 
1.315     albertel 7526:     $env{'internal.start_page'}++;
1.1096    raeburn  7527:     my ($result,@advtools);
1.964     droeschl 7528: 
1.338     albertel 7529:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      7530:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 7531:     }
                   7532:     
                   7533:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7534: 	if ($args->{'frameset'}) {
                   7535: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7536: 						$args->{'add_entries'});
                   7537: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7538:         } else {
                   7539:             $result .=
                   7540:                 &bodytag($title, 
                   7541:                          $args->{'function'},       $args->{'add_entries'},
                   7542:                          $args->{'only_body'},      $args->{'domain'},
                   7543:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096    raeburn  7544:                          $args->{'bgcolor'},        $args,
                   7545:                          \@advtools);
1.831     bisitz   7546:         }
1.330     albertel 7547:     }
1.338     albertel 7548: 
1.315     albertel 7549:     if ($args->{'js_ready'}) {
1.713     kaisler  7550: 		$result = &js_ready($result);
1.315     albertel 7551:     }
1.320     albertel 7552:     if ($args->{'html_encode'}) {
1.713     kaisler  7553: 		$result = &html_encode($result);
                   7554:     }
                   7555: 
1.813     bisitz   7556:     # Preparation for new and consistent functionlist at top of screen
                   7557:     # if ($args->{'functionlist'}) {
                   7558:     #            $result .= &build_functionlist();
                   7559:     #}
                   7560: 
1.964     droeschl 7561:     # Don't add anything more if only_body wanted or in const space
                   7562:     return $result if    $args->{'only_body'} 
                   7563:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7564: 
                   7565:     #Breadcrumbs
1.758     kaisler  7566:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7567: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7568: 		#if any br links exists, add them to the breadcrumbs
                   7569: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7570: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7571: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7572: 			}
                   7573: 		}
1.1096    raeburn  7574:                 # if @advtools array contains items add then to the breadcrumbs
                   7575:                 if (@advtools > 0) {
                   7576:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7577:                 }
1.758     kaisler  7578: 
                   7579: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7580: 		if(exists($args->{'bread_crumbs_component'})){
                   7581: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7582: 		}else{
                   7583: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7584: 		}
1.320     albertel 7585:     }
1.315     albertel 7586:     return $result;
1.306     albertel 7587: }
                   7588: 
                   7589: sub end_page {
1.315     albertel 7590:     my ($args) = @_;
                   7591:     $env{'internal.end_page'}++;
1.330     albertel 7592:     my $result;
1.335     albertel 7593:     if ($args->{'discussion'}) {
                   7594: 	my ($target,$parser);
                   7595: 	if (ref($args->{'discussion'})) {
                   7596: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7597: 				$args->{'discussion'}{'parser'});
                   7598: 	}
                   7599: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7600:     }
1.330     albertel 7601:     if ($args->{'frameset'}) {
                   7602: 	$result .= '</frameset>';
                   7603:     } else {
1.635     raeburn  7604: 	$result .= &endbodytag($args);
1.330     albertel 7605:     }
1.1080    raeburn  7606:     unless ($args->{'notbody'}) {
                   7607:         $result .= "\n</html>";
                   7608:     }
1.330     albertel 7609: 
1.315     albertel 7610:     if ($args->{'js_ready'}) {
1.317     albertel 7611: 	$result = &js_ready($result);
1.315     albertel 7612:     }
1.335     albertel 7613: 
1.320     albertel 7614:     if ($args->{'html_encode'}) {
                   7615: 	$result = &html_encode($result);
                   7616:     }
1.335     albertel 7617: 
1.315     albertel 7618:     return $result;
                   7619: }
                   7620: 
1.1034    www      7621: sub wishlist_window {
                   7622:     return(<<'ENDWISHLIST');
1.1046    raeburn  7623: <script type="text/javascript">
1.1034    www      7624: // <![CDATA[
                   7625: // <!-- BEGIN LON-CAPA Internal
                   7626: function set_wishlistlink(title, path) {
                   7627:     if (!title) {
                   7628:         title = document.title;
                   7629:         title = title.replace(/^LON-CAPA /,'');
                   7630:     }
                   7631:     if (!path) {
                   7632:         path = location.pathname;
                   7633:     }
                   7634:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7635:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7636: }
                   7637: // END LON-CAPA Internal -->
                   7638: // ]]>
                   7639: </script>
                   7640: ENDWISHLIST
                   7641: }
                   7642: 
1.1030    www      7643: sub modal_window {
                   7644:     return(<<'ENDMODAL');
1.1046    raeburn  7645: <script type="text/javascript">
1.1030    www      7646: // <![CDATA[
                   7647: // <!-- BEGIN LON-CAPA Internal
                   7648: var modalWindow = {
                   7649: 	parent:"body",
                   7650: 	windowId:null,
                   7651: 	content:null,
                   7652: 	width:null,
                   7653: 	height:null,
                   7654: 	close:function()
                   7655: 	{
                   7656: 	        $(".LCmodal-window").remove();
                   7657: 	        $(".LCmodal-overlay").remove();
                   7658: 	},
                   7659: 	open:function()
                   7660: 	{
                   7661: 		var modal = "";
                   7662: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7663: 		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;\">";
                   7664: 		modal += this.content;
                   7665: 		modal += "</div>";	
                   7666: 
                   7667: 		$(this.parent).append(modal);
                   7668: 
                   7669: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7670: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7671: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7672: 	}
                   7673: };
1.1140    raeburn  7674: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      7675: 	{
                   7676: 		modalWindow.windowId = "myModal";
                   7677: 		modalWindow.width = width;
                   7678: 		modalWindow.height = height;
1.1140    raeburn  7679: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'>&lt/iframe>";
1.1030    www      7680: 		modalWindow.open();
                   7681: 	};	
                   7682: // END LON-CAPA Internal -->
                   7683: // ]]>
                   7684: </script>
                   7685: ENDMODAL
                   7686: }
                   7687: 
                   7688: sub modal_link {
1.1140    raeburn  7689:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      7690:     unless ($width) { $width=480; }
                   7691:     unless ($height) { $height=400; }
1.1031    www      7692:     unless ($scrolling) { $scrolling='yes'; }
1.1140    raeburn  7693:     unless ($transparency) { $transparency='true'; }
                   7694: 
1.1074    raeburn  7695:     my $target_attr;
                   7696:     if (defined($target)) {
                   7697:         $target_attr = 'target="'.$target.'"';
                   7698:     }
                   7699:     return <<"ENDLINK";
1.1140    raeburn  7700: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  7701:            $linktext</a>
                   7702: ENDLINK
1.1030    www      7703: }
                   7704: 
1.1032    www      7705: sub modal_adhoc_script {
                   7706:     my ($funcname,$width,$height,$content)=@_;
                   7707:     return (<<ENDADHOC);
1.1046    raeburn  7708: <script type="text/javascript">
1.1032    www      7709: // <![CDATA[
                   7710:         var $funcname = function()
                   7711:         {
                   7712:                 modalWindow.windowId = "myModal";
                   7713:                 modalWindow.width = $width;
                   7714:                 modalWindow.height = $height;
                   7715:                 modalWindow.content = '$content';
                   7716:                 modalWindow.open();
                   7717:         };  
                   7718: // ]]>
                   7719: </script>
                   7720: ENDADHOC
                   7721: }
                   7722: 
1.1041    www      7723: sub modal_adhoc_inner {
                   7724:     my ($funcname,$width,$height,$content)=@_;
                   7725:     my $innerwidth=$width-20;
                   7726:     $content=&js_ready(
1.1140    raeburn  7727:                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   7728:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   7729:                  $content.
1.1041    www      7730:                  &end_scrollbox().
1.1140    raeburn  7731:                  &end_page()
1.1041    www      7732:              );
                   7733:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7734: }
                   7735: 
                   7736: sub modal_adhoc_window {
                   7737:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7738:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7739:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7740: }
                   7741: 
                   7742: sub modal_adhoc_launch {
                   7743:     my ($funcname,$width,$height,$content)=@_;
                   7744:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7745: <script type="text/javascript">
                   7746: // <![CDATA[
                   7747: $funcname();
                   7748: // ]]>
                   7749: </script>
                   7750: ENDLAUNCH
                   7751: }
                   7752: 
                   7753: sub modal_adhoc_close {
                   7754:     return (<<ENDCLOSE);
                   7755: <script type="text/javascript">
                   7756: // <![CDATA[
                   7757: modalWindow.close();
                   7758: // ]]>
                   7759: </script>
                   7760: ENDCLOSE
                   7761: }
                   7762: 
1.1038    www      7763: sub togglebox_script {
                   7764:    return(<<ENDTOGGLE);
                   7765: <script type="text/javascript"> 
                   7766: // <![CDATA[
                   7767: function LCtoggleDisplay(id,hidetext,showtext) {
                   7768:    link = document.getElementById(id + "link").childNodes[0];
                   7769:    with (document.getElementById(id).style) {
                   7770:       if (display == "none" ) {
                   7771:           display = "inline";
                   7772:           link.nodeValue = hidetext;
                   7773:         } else {
                   7774:           display = "none";
                   7775:           link.nodeValue = showtext;
                   7776:        }
                   7777:    }
                   7778: }
                   7779: // ]]>
                   7780: </script>
                   7781: ENDTOGGLE
                   7782: }
                   7783: 
1.1039    www      7784: sub start_togglebox {
                   7785:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7786:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7787:     unless ($showtext) { $showtext=&mt('show'); }
                   7788:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7789:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7790:     return &start_data_table().
                   7791:            &start_data_table_header_row().
                   7792:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7793:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7794:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7795:            &end_data_table_header_row().
                   7796:            '<tr id="'.$id.'" style="display:none""><td>';
                   7797: }
                   7798: 
                   7799: sub end_togglebox {
                   7800:     return '</td></tr>'.&end_data_table();
                   7801: }
                   7802: 
1.1041    www      7803: sub LCprogressbar_script {
1.1045    www      7804:    my ($id)=@_;
1.1041    www      7805:    return(<<ENDPROGRESS);
                   7806: <script type="text/javascript">
                   7807: // <![CDATA[
1.1045    www      7808: \$('#progressbar$id').progressbar({
1.1041    www      7809:   value: 0,
                   7810:   change: function(event, ui) {
                   7811:     var newVal = \$(this).progressbar('option', 'value');
                   7812:     \$('.pblabel', this).text(LCprogressTxt);
                   7813:   }
                   7814: });
                   7815: // ]]>
                   7816: </script>
                   7817: ENDPROGRESS
                   7818: }
                   7819: 
                   7820: sub LCprogressbarUpdate_script {
                   7821:    return(<<ENDPROGRESSUPDATE);
                   7822: <style type="text/css">
                   7823: .ui-progressbar { position:relative; }
                   7824: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7825: </style>
                   7826: <script type="text/javascript">
                   7827: // <![CDATA[
1.1045    www      7828: var LCprogressTxt='---';
                   7829: 
                   7830: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7831:    LCprogressTxt=progresstext;
1.1045    www      7832:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7833: }
                   7834: // ]]>
                   7835: </script>
                   7836: ENDPROGRESSUPDATE
                   7837: }
                   7838: 
1.1042    www      7839: my $LClastpercent;
1.1045    www      7840: my $LCidcnt;
                   7841: my $LCcurrentid;
1.1042    www      7842: 
1.1041    www      7843: sub LCprogressbar {
1.1042    www      7844:     my ($r)=(@_);
                   7845:     $LClastpercent=0;
1.1045    www      7846:     $LCidcnt++;
                   7847:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7848:     my $starting=&mt('Starting');
                   7849:     my $content=(<<ENDPROGBAR);
1.1045    www      7850:   <div id="progressbar$LCcurrentid">
1.1041    www      7851:     <span class="pblabel">$starting</span>
                   7852:   </div>
                   7853: ENDPROGBAR
1.1045    www      7854:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7855: }
                   7856: 
                   7857: sub LCprogressbarUpdate {
1.1042    www      7858:     my ($r,$val,$text)=@_;
                   7859:     unless ($val) { 
                   7860:        if ($LClastpercent) {
                   7861:            $val=$LClastpercent;
                   7862:        } else {
                   7863:            $val=0;
                   7864:        }
                   7865:     }
1.1041    www      7866:     if ($val<0) { $val=0; }
                   7867:     if ($val>100) { $val=0; }
1.1042    www      7868:     $LClastpercent=$val;
1.1041    www      7869:     unless ($text) { $text=$val.'%'; }
                   7870:     $text=&js_ready($text);
1.1044    www      7871:     &r_print($r,<<ENDUPDATE);
1.1041    www      7872: <script type="text/javascript">
                   7873: // <![CDATA[
1.1045    www      7874: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7875: // ]]>
                   7876: </script>
                   7877: ENDUPDATE
1.1035    www      7878: }
                   7879: 
1.1042    www      7880: sub LCprogressbarClose {
                   7881:     my ($r)=@_;
                   7882:     $LClastpercent=0;
1.1044    www      7883:     &r_print($r,<<ENDCLOSE);
1.1042    www      7884: <script type="text/javascript">
                   7885: // <![CDATA[
1.1045    www      7886: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7887: // ]]>
                   7888: </script>
                   7889: ENDCLOSE
1.1044    www      7890: }
                   7891: 
                   7892: sub r_print {
                   7893:     my ($r,$to_print)=@_;
                   7894:     if ($r) {
                   7895:       $r->print($to_print);
                   7896:       $r->rflush();
                   7897:     } else {
                   7898:       print($to_print);
                   7899:     }
1.1042    www      7900: }
                   7901: 
1.320     albertel 7902: sub html_encode {
                   7903:     my ($result) = @_;
                   7904: 
1.322     albertel 7905:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7906:     
                   7907:     return $result;
                   7908: }
1.1044    www      7909: 
1.317     albertel 7910: sub js_ready {
                   7911:     my ($result) = @_;
                   7912: 
1.323     albertel 7913:     $result =~ s/[\n\r]/ /xmsg;
                   7914:     $result =~ s/\\/\\\\/xmsg;
                   7915:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7916:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7917:     
                   7918:     return $result;
                   7919: }
                   7920: 
1.315     albertel 7921: sub validate_page {
                   7922:     if (  exists($env{'internal.start_page'})
1.316     albertel 7923: 	  &&     $env{'internal.start_page'} > 1) {
                   7924: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7925: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7926: 				 $ENV{'request.filename'});
1.315     albertel 7927:     }
                   7928:     if (  exists($env{'internal.end_page'})
1.316     albertel 7929: 	  &&     $env{'internal.end_page'} > 1) {
                   7930: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7931: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7932: 				 $env{'request.filename'});
1.315     albertel 7933:     }
                   7934:     if (     exists($env{'internal.start_page'})
                   7935: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7936: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7937: 				 $env{'request.filename'});
1.315     albertel 7938:     }
                   7939:     if (   ! exists($env{'internal.start_page'})
                   7940: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7941: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7942: 				 $env{'request.filename'});
1.315     albertel 7943:     }
1.306     albertel 7944: }
1.315     albertel 7945: 
1.996     www      7946: 
                   7947: sub start_scrollbox {
1.1140    raeburn  7948:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  7949:     unless ($outerwidth) { $outerwidth='520px'; }
                   7950:     unless ($width) { $width='500px'; }
                   7951:     unless ($height) { $height='200px'; }
1.1075    raeburn  7952:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7953:     if ($id ne '') {
1.1140    raeburn  7954:         $table_id = ' id="table_'.$id.'"';
1.1137    raeburn  7955:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  7956:     }
1.1075    raeburn  7957:     if ($bgcolor ne '') {
                   7958:         $tdcol = "background-color: $bgcolor;";
                   7959:     }
1.1137    raeburn  7960:     my $nicescroll_js;
                   7961:     if ($env{'browser.mobile'}) {
1.1140    raeburn  7962:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   7963:     }
                   7964:     return <<"END";
                   7965: $nicescroll_js
                   7966: 
                   7967: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   7968: <div style="overflow:auto; width:$width; height:$height;"$div_id>
                   7969: END
                   7970: }
                   7971: 
                   7972: sub end_scrollbox {
                   7973:     return '</div></td></tr></table>';
                   7974: }
                   7975: 
                   7976: sub nicescroll_javascript {
                   7977:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   7978:     my %options;
                   7979:     if (ref($cursor) eq 'HASH') {
                   7980:         %options = %{$cursor};
                   7981:     }
                   7982:     unless ($options{'railalign'} =~ /^left|right$/) {
                   7983:         $options{'railalign'} = 'left';
                   7984:     }
                   7985:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   7986:         my $function  = &get_users_function();
                   7987:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138    raeburn  7988:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140    raeburn  7989:             $options{'cursorcolor'} = '#00F';
1.1138    raeburn  7990:         }
1.1140    raeburn  7991:     }
                   7992:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   7993:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138    raeburn  7994:             $options{'cursoropacity'}='1.0';
                   7995:         }
1.1140    raeburn  7996:     } else {
                   7997:         $options{'cursoropacity'}='1.0';
                   7998:     }
                   7999:     if ($options{'cursorfixedheight'} eq 'none') {
                   8000:         delete($options{'cursorfixedheight'});
                   8001:     } else {
                   8002:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8003:     }
                   8004:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8005:         delete($options{'railoffset'});
                   8006:     }
                   8007:     my @niceoptions;
                   8008:     while (my($key,$value) = each(%options)) {
                   8009:         if ($value =~ /^\{.+\}$/) {
                   8010:             push(@niceoptions,$key.':'.$value);
1.1138    raeburn  8011:         } else {
1.1140    raeburn  8012:             push(@niceoptions,$key.':"'.$value.'"');
1.1138    raeburn  8013:         }
1.1140    raeburn  8014:     }
                   8015:     my $nicescroll_js = '
1.1137    raeburn  8016: $(document).ready(
1.1140    raeburn  8017:       function() {
                   8018:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8019:       }
1.1137    raeburn  8020: );
                   8021: ';
1.1140    raeburn  8022:     if ($framecheck) {
                   8023:         $nicescroll_js .= '
                   8024: function expand_div(caller) {
                   8025:     if (top === self) {
                   8026:         document.getElementById("'.$id.'").style.width = "auto";
                   8027:         document.getElementById("'.$id.'").style.height = "auto";
                   8028:     } else {
                   8029:         try {
                   8030:             if (parent.frames) {
                   8031:                 if (parent.frames.length > 1) {
                   8032:                     var framesrc = parent.frames[1].location.href;
                   8033:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8034:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8035:                         document.getElementById("'.$id.'").style.width = "auto";
                   8036:                         document.getElementById("'.$id.'").style.height = "auto";
                   8037:                     }
                   8038:                 }
                   8039:             }
                   8040:         } catch (e) {
                   8041:             return;
                   8042:         }
1.1137    raeburn  8043:     }
1.1140    raeburn  8044:     return;
1.996     www      8045: }
1.1140    raeburn  8046: ';
                   8047:     }
                   8048:     if ($needjsready) {
                   8049:         $nicescroll_js = '
                   8050: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8051:     } else {
                   8052:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8053:     }
                   8054:     return $nicescroll_js;
1.996     www      8055: }
                   8056: 
1.318     albertel 8057: sub simple_error_page {
1.1150    bisitz   8058:     my ($r,$title,$msg,$args) = @_;
1.1151    raeburn  8059:     if (ref($args) eq 'HASH') {
                   8060:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8061:     } else {
                   8062:         $msg = &mt($msg);
                   8063:     }
1.1150    bisitz   8064: 
1.318     albertel 8065:     my $page =
                   8066: 	&Apache::loncommon::start_page($title).
1.1150    bisitz   8067: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8068: 	&Apache::loncommon::end_page();
                   8069:     if (ref($r)) {
                   8070: 	$r->print($page);
1.327     albertel 8071: 	return;
1.318     albertel 8072:     }
                   8073:     return $page;
                   8074: }
1.347     albertel 8075: 
                   8076: {
1.610     albertel 8077:     my @row_count;
1.961     onken    8078: 
                   8079:     sub start_data_table_count {
                   8080:         unshift(@row_count, 0);
                   8081:         return;
                   8082:     }
                   8083: 
                   8084:     sub end_data_table_count {
                   8085:         shift(@row_count);
                   8086:         return;
                   8087:     }
                   8088: 
1.347     albertel 8089:     sub start_data_table {
1.1018    raeburn  8090: 	my ($add_class,$id) = @_;
1.422     albertel 8091: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8092:         my $table_id;
                   8093:         if (defined($id)) {
                   8094:             $table_id = ' id="'.$id.'"';
                   8095:         }
1.961     onken    8096: 	&start_data_table_count();
1.1018    raeburn  8097: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8098:     }
                   8099: 
                   8100:     sub end_data_table {
1.961     onken    8101: 	&end_data_table_count();
1.389     albertel 8102: 	return '</table>'."\n";;
1.347     albertel 8103:     }
                   8104: 
                   8105:     sub start_data_table_row {
1.974     wenzelju 8106: 	my ($add_class, $id) = @_;
1.610     albertel 8107: 	$row_count[0]++;
                   8108: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8109: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8110:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8111:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8112:     }
1.471     banghart 8113:     
                   8114:     sub continue_data_table_row {
1.974     wenzelju 8115: 	my ($add_class, $id) = @_;
1.610     albertel 8116: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8117: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8118:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8119:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8120:     }
1.347     albertel 8121: 
                   8122:     sub end_data_table_row {
1.389     albertel 8123: 	return '</tr>'."\n";;
1.347     albertel 8124:     }
1.367     www      8125: 
1.421     albertel 8126:     sub start_data_table_empty_row {
1.707     bisitz   8127: #	$row_count[0]++;
1.421     albertel 8128: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8129:     }
                   8130: 
                   8131:     sub end_data_table_empty_row {
                   8132: 	return '</tr>'."\n";;
                   8133:     }
                   8134: 
1.367     www      8135:     sub start_data_table_header_row {
1.389     albertel 8136: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8137:     }
                   8138: 
                   8139:     sub end_data_table_header_row {
1.389     albertel 8140: 	return '</tr>'."\n";;
1.367     www      8141:     }
1.890     droeschl 8142: 
                   8143:     sub data_table_caption {
                   8144:         my $caption = shift;
                   8145:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8146:     }
1.347     albertel 8147: }
                   8148: 
1.548     albertel 8149: =pod
                   8150: 
                   8151: =item * &inhibit_menu_check($arg)
                   8152: 
                   8153: Checks for a inhibitmenu state and generates output to preserve it
                   8154: 
                   8155: Inputs:         $arg - can be any of
                   8156:                      - undef - in which case the return value is a string 
                   8157:                                to add  into arguments list of a uri
                   8158:                      - 'input' - in which case the return value is a HTML
                   8159:                                  <form> <input> field of type hidden to
                   8160:                                  preserve the value
                   8161:                      - a url - in which case the return value is the url with
                   8162:                                the neccesary cgi args added to preserve the
                   8163:                                inhibitmenu state
                   8164:                      - a ref to a url - no return value, but the string is
                   8165:                                         updated to include the neccessary cgi
                   8166:                                         args to preserve the inhibitmenu state
                   8167: 
                   8168: =cut
                   8169: 
                   8170: sub inhibit_menu_check {
                   8171:     my ($arg) = @_;
                   8172:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8173:     if ($arg eq 'input') {
                   8174: 	if ($env{'form.inhibitmenu'}) {
                   8175: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8176: 	} else {
                   8177: 	    return
                   8178: 	}
                   8179:     }
                   8180:     if ($env{'form.inhibitmenu'}) {
                   8181: 	if (ref($arg)) {
                   8182: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8183: 	} elsif ($arg eq '') {
                   8184: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8185: 	} else {
                   8186: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8187: 	}
                   8188:     }
                   8189:     if (!ref($arg)) {
                   8190: 	return $arg;
                   8191:     }
                   8192: }
                   8193: 
1.251     albertel 8194: ###############################################
1.182     matthew  8195: 
                   8196: =pod
                   8197: 
1.549     albertel 8198: =back
                   8199: 
                   8200: =head1 User Information Routines
                   8201: 
                   8202: =over 4
                   8203: 
1.405     albertel 8204: =item * &get_users_function()
1.182     matthew  8205: 
                   8206: Used by &bodytag to determine the current users primary role.
                   8207: Returns either 'student','coordinator','admin', or 'author'.
                   8208: 
                   8209: =cut
                   8210: 
                   8211: ###############################################
                   8212: sub get_users_function {
1.815     tempelho 8213:     my $function = 'norole';
1.818     tempelho 8214:     if ($env{'request.role'}=~/^(st)/) {
                   8215:         $function='student';
                   8216:     }
1.907     raeburn  8217:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8218:         $function='coordinator';
                   8219:     }
1.258     albertel 8220:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8221:         $function='admin';
                   8222:     }
1.826     bisitz   8223:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8224:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8225:         $function='author';
                   8226:     }
                   8227:     return $function;
1.54      www      8228: }
1.99      www      8229: 
                   8230: ###############################################
                   8231: 
1.233     raeburn  8232: =pod
                   8233: 
1.821     raeburn  8234: =item * &show_course()
                   8235: 
                   8236: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8237: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8238: 
                   8239: Inputs:
                   8240: None
                   8241: 
                   8242: Outputs:
                   8243: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8244: 
                   8245: =cut
                   8246: 
                   8247: ###############################################
                   8248: sub show_course {
                   8249:     my $course = !$env{'user.adv'};
                   8250:     if (!$env{'user.adv'}) {
                   8251:         foreach my $env (keys(%env)) {
                   8252:             next if ($env !~ m/^user\.priv\./);
                   8253:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8254:                 $course = 0;
                   8255:                 last;
                   8256:             }
                   8257:         }
                   8258:     }
                   8259:     return $course;
                   8260: }
                   8261: 
                   8262: ###############################################
                   8263: 
                   8264: =pod
                   8265: 
1.542     raeburn  8266: =item * &check_user_status()
1.274     raeburn  8267: 
                   8268: Determines current status of supplied role for a
                   8269: specific user. Roles can be active, previous or future.
                   8270: 
                   8271: Inputs: 
                   8272: user's domain, user's username, course's domain,
1.375     raeburn  8273: course's number, optional section ID.
1.274     raeburn  8274: 
                   8275: Outputs:
                   8276: role status: active, previous or future. 
                   8277: 
                   8278: =cut
                   8279: 
                   8280: sub check_user_status {
1.412     raeburn  8281:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8282:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8283:     my @uroles = keys %userinfo;
                   8284:     my $srchstr;
                   8285:     my $active_chk = 'none';
1.412     raeburn  8286:     my $now = time;
1.274     raeburn  8287:     if (@uroles > 0) {
1.908     raeburn  8288:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8289:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8290:         } else {
1.412     raeburn  8291:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8292:         }
                   8293:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8294:             my $role_end = 0;
                   8295:             my $role_start = 0;
                   8296:             $active_chk = 'active';
1.412     raeburn  8297:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8298:                 $role_end = $1;
                   8299:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8300:                     $role_start = $1;
1.274     raeburn  8301:                 }
                   8302:             }
                   8303:             if ($role_start > 0) {
1.412     raeburn  8304:                 if ($now < $role_start) {
1.274     raeburn  8305:                     $active_chk = 'future';
                   8306:                 }
                   8307:             }
                   8308:             if ($role_end > 0) {
1.412     raeburn  8309:                 if ($now > $role_end) {
1.274     raeburn  8310:                     $active_chk = 'previous';
                   8311:                 }
                   8312:             }
                   8313:         }
                   8314:     }
                   8315:     return $active_chk;
                   8316: }
                   8317: 
                   8318: ###############################################
                   8319: 
                   8320: =pod
                   8321: 
1.405     albertel 8322: =item * &get_sections()
1.233     raeburn  8323: 
                   8324: Determines all the sections for a course including
                   8325: sections with students and sections containing other roles.
1.419     raeburn  8326: Incoming parameters: 
                   8327: 
                   8328: 1. domain
                   8329: 2. course number 
                   8330: 3. reference to array containing roles for which sections should 
                   8331: be gathered (optional).
                   8332: 4. reference to array containing status types for which sections 
                   8333: should be gathered (optional).
                   8334: 
                   8335: If the third argument is undefined, sections are gathered for any role. 
                   8336: If the fourth argument is undefined, sections are gathered for any status.
                   8337: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8338:  
1.374     raeburn  8339: Returns section hash (keys are section IDs, values are
                   8340: number of users in each section), subject to the
1.419     raeburn  8341: optional roles filter, optional status filter 
1.233     raeburn  8342: 
                   8343: =cut
                   8344: 
                   8345: ###############################################
                   8346: sub get_sections {
1.419     raeburn  8347:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8348:     if (!defined($cdom) || !defined($cnum)) {
                   8349:         my $cid =  $env{'request.course.id'};
                   8350: 
                   8351: 	return if (!defined($cid));
                   8352: 
                   8353:         $cdom = $env{'course.'.$cid.'.domain'};
                   8354:         $cnum = $env{'course.'.$cid.'.num'};
                   8355:     }
                   8356: 
                   8357:     my %sectioncount;
1.419     raeburn  8358:     my $now = time;
1.240     albertel 8359: 
1.1118    raeburn  8360:     my $check_students = 1;
                   8361:     my $only_students = 0;
                   8362:     if (ref($possible_roles) eq 'ARRAY') {
                   8363:         if (grep(/^st$/,@{$possible_roles})) {
                   8364:             if (@{$possible_roles} == 1) {
                   8365:                 $only_students = 1;
                   8366:             }
                   8367:         } else {
                   8368:             $check_students = 0;
                   8369:         }
                   8370:     }
                   8371: 
                   8372:     if ($check_students) { 
1.276     albertel 8373: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8374: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8375: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8376:         my $start_index = &Apache::loncoursedata::CL_START();
                   8377:         my $end_index = &Apache::loncoursedata::CL_END();
                   8378:         my $status;
1.366     albertel 8379: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8380: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8381: 				                     $data->[$status_index],
                   8382:                                                      $data->[$start_index],
                   8383:                                                      $data->[$end_index]);
                   8384:             if ($stu_status eq 'Active') {
                   8385:                 $status = 'active';
                   8386:             } elsif ($end < $now) {
                   8387:                 $status = 'previous';
                   8388:             } elsif ($start > $now) {
                   8389:                 $status = 'future';
                   8390:             } 
                   8391: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8392:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8393:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8394: 		    $sectioncount{$section}++;
                   8395:                 }
1.240     albertel 8396: 	    }
                   8397: 	}
                   8398:     }
1.1118    raeburn  8399:     if ($only_students) {
                   8400:         return %sectioncount;
                   8401:     }
1.240     albertel 8402:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8403:     foreach my $user (sort(keys(%courseroles))) {
                   8404: 	if ($user !~ /^(\w{2})/) { next; }
                   8405: 	my ($role) = ($user =~ /^(\w{2})/);
                   8406: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8407: 	my ($section,$status);
1.240     albertel 8408: 	if ($role eq 'cr' &&
                   8409: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8410: 	    $section=$1;
                   8411: 	}
                   8412: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8413: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8414:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8415:         if ($end == -1 && $start == -1) {
                   8416:             next; #deleted role
                   8417:         }
                   8418:         if (!defined($possible_status)) { 
                   8419:             $sectioncount{$section}++;
                   8420:         } else {
                   8421:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8422:                 $status = 'active';
                   8423:             } elsif ($end < $now) {
                   8424:                 $status = 'future';
                   8425:             } elsif ($start > $now) {
                   8426:                 $status = 'previous';
                   8427:             }
                   8428:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8429:                 $sectioncount{$section}++;
                   8430:             }
                   8431:         }
1.233     raeburn  8432:     }
1.366     albertel 8433:     return %sectioncount;
1.233     raeburn  8434: }
                   8435: 
1.274     raeburn  8436: ###############################################
1.294     raeburn  8437: 
                   8438: =pod
1.405     albertel 8439: 
                   8440: =item * &get_course_users()
                   8441: 
1.275     raeburn  8442: Retrieves usernames:domains for users in the specified course
                   8443: with specific role(s), and access status. 
                   8444: 
                   8445: Incoming parameters:
1.277     albertel 8446: 1. course domain
                   8447: 2. course number
                   8448: 3. access status: users must have - either active, 
1.275     raeburn  8449: previous, future, or all.
1.277     albertel 8450: 4. reference to array of permissible roles
1.288     raeburn  8451: 5. reference to array of section restrictions (optional)
                   8452: 6. reference to results object (hash of hashes).
                   8453: 7. reference to optional userdata hash
1.609     raeburn  8454: 8. reference to optional statushash
1.630     raeburn  8455: 9. flag if privileged users (except those set to unhide in
                   8456:    course settings) should be excluded    
1.609     raeburn  8457: Keys of top level results hash are roles.
1.275     raeburn  8458: Keys of inner hashes are username:domain, with 
                   8459: values set to access type.
1.288     raeburn  8460: Optional userdata hash returns an array with arguments in the 
                   8461: same order as loncoursedata::get_classlist() for student data.
                   8462: 
1.609     raeburn  8463: Optional statushash returns
                   8464: 
1.288     raeburn  8465: Entries for end, start, section and status are blank because
                   8466: of the possibility of multiple values for non-student roles.
                   8467: 
1.275     raeburn  8468: =cut
1.405     albertel 8469: 
1.275     raeburn  8470: ###############################################
1.405     albertel 8471: 
1.275     raeburn  8472: sub get_course_users {
1.630     raeburn  8473:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8474:     my %idx = ();
1.419     raeburn  8475:     my %seclists;
1.288     raeburn  8476: 
                   8477:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8478:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8479:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8480:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8481:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8482:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8483:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8484:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8485: 
1.290     albertel 8486:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8487:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8488:         my $now = time;
1.277     albertel 8489:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8490:             my $match = 0;
1.412     raeburn  8491:             my $secmatch = 0;
1.419     raeburn  8492:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8493:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8494:             if ($section eq '') {
                   8495:                 $section = 'none';
                   8496:             }
1.291     albertel 8497:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8498:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8499:                     $secmatch = 1;
                   8500:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8501:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8502:                         $secmatch = 1;
                   8503:                     }
                   8504:                 } else {  
1.419     raeburn  8505: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8506: 		        $secmatch = 1;
                   8507:                     }
1.290     albertel 8508: 		}
1.412     raeburn  8509:                 if (!$secmatch) {
                   8510:                     next;
                   8511:                 }
1.419     raeburn  8512:             }
1.275     raeburn  8513:             if (defined($$types{'active'})) {
1.288     raeburn  8514:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8515:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8516:                     $match = 1;
1.275     raeburn  8517:                 }
                   8518:             }
                   8519:             if (defined($$types{'previous'})) {
1.609     raeburn  8520:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8521:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8522:                     $match = 1;
1.275     raeburn  8523:                 }
                   8524:             }
                   8525:             if (defined($$types{'future'})) {
1.609     raeburn  8526:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8527:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8528:                     $match = 1;
1.275     raeburn  8529:                 }
                   8530:             }
1.609     raeburn  8531:             if ($match) {
                   8532:                 push(@{$seclists{$student}},$section);
                   8533:                 if (ref($userdata) eq 'HASH') {
                   8534:                     $$userdata{$student} = $$classlist{$student};
                   8535:                 }
                   8536:                 if (ref($statushash) eq 'HASH') {
                   8537:                     $statushash->{$student}{'st'}{$section} = $status;
                   8538:                 }
1.288     raeburn  8539:             }
1.275     raeburn  8540:         }
                   8541:     }
1.412     raeburn  8542:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8543:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8544:         my $now = time;
1.609     raeburn  8545:         my %displaystatus = ( previous => 'Expired',
                   8546:                               active   => 'Active',
                   8547:                               future   => 'Future',
                   8548:                             );
1.1121    raeburn  8549:         my (%nothide,@possdoms);
1.630     raeburn  8550:         if ($hidepriv) {
                   8551:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8552:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8553:                 if ($user !~ /:/) {
                   8554:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8555:                 } else {
                   8556:                     $nothide{$user} = 1;
                   8557:                 }
                   8558:             }
1.1121    raeburn  8559:             my @possdoms = ($cdom);
                   8560:             if ($coursehash{'checkforpriv'}) {
                   8561:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   8562:             }
1.630     raeburn  8563:         }
1.439     raeburn  8564:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8565:             my $match = 0;
1.412     raeburn  8566:             my $secmatch = 0;
1.439     raeburn  8567:             my $status;
1.412     raeburn  8568:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8569:             $user =~ s/:$//;
1.439     raeburn  8570:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8571:             if ($end == -1 || $start == -1) {
                   8572:                 next;
                   8573:             }
                   8574:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8575:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8576:                 my ($uname,$udom) = split(/:/,$user);
                   8577:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8578:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8579:                         $secmatch = 1;
                   8580:                     } elsif ($usec eq '') {
1.420     albertel 8581:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8582:                             $secmatch = 1;
                   8583:                         }
                   8584:                     } else {
                   8585:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8586:                             $secmatch = 1;
                   8587:                         }
                   8588:                     }
                   8589:                     if (!$secmatch) {
                   8590:                         next;
                   8591:                     }
1.288     raeburn  8592:                 }
1.419     raeburn  8593:                 if ($usec eq '') {
                   8594:                     $usec = 'none';
                   8595:                 }
1.275     raeburn  8596:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8597:                     if ($hidepriv) {
1.1121    raeburn  8598:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  8599:                             (!$nothide{$uname.':'.$udom})) {
                   8600:                             next;
                   8601:                         }
                   8602:                     }
1.503     raeburn  8603:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8604:                         $status = 'previous';
                   8605:                     } elsif ($start > $now) {
                   8606:                         $status = 'future';
                   8607:                     } else {
                   8608:                         $status = 'active';
                   8609:                     }
1.277     albertel 8610:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8611:                         if ($status eq $type) {
1.420     albertel 8612:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8613:                                 push(@{$$users{$role}{$user}},$type);
                   8614:                             }
1.288     raeburn  8615:                             $match = 1;
                   8616:                         }
                   8617:                     }
1.419     raeburn  8618:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8619:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8620: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8621:                         }
1.420     albertel 8622:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8623:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8624:                         }
1.609     raeburn  8625:                         if (ref($statushash) eq 'HASH') {
                   8626:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8627:                         }
1.275     raeburn  8628:                     }
                   8629:                 }
                   8630:             }
                   8631:         }
1.290     albertel 8632:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8633:             if ((defined($cdom)) && (defined($cnum))) {
                   8634:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8635:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8636:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8637:                     next if ($owner eq '');
                   8638:                     my ($ownername,$ownerdom);
                   8639:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8640:                         $ownername = $1;
                   8641:                         $ownerdom = $2;
                   8642:                     } else {
                   8643:                         $ownername = $owner;
                   8644:                         $ownerdom = $cdom;
                   8645:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8646:                     }
                   8647:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8648:                     if (defined($userdata) && 
1.609     raeburn  8649: 			!exists($$userdata{$owner})) {
                   8650: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8651:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8652:                             push(@{$seclists{$owner}},'none');
                   8653:                         }
                   8654:                         if (ref($statushash) eq 'HASH') {
                   8655:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8656:                         }
1.290     albertel 8657: 		    }
1.279     raeburn  8658:                 }
                   8659:             }
                   8660:         }
1.419     raeburn  8661:         foreach my $user (keys(%seclists)) {
                   8662:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8663:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8664:         }
1.275     raeburn  8665:     }
                   8666:     return;
                   8667: }
                   8668: 
1.288     raeburn  8669: sub get_user_info {
                   8670:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8671:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8672: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8673:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8674:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8675:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8676:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8677:     return;
                   8678: }
1.275     raeburn  8679: 
1.472     raeburn  8680: ###############################################
                   8681: 
                   8682: =pod
                   8683: 
                   8684: =item * &get_user_quota()
                   8685: 
1.1134    raeburn  8686: Retrieves quota assigned for storage of user files.
                   8687: Default is to report quota for portfolio files.
1.472     raeburn  8688: 
                   8689: Incoming parameters:
                   8690: 1. user's username
                   8691: 2. user's domain
1.1134    raeburn  8692: 3. quota name - portfolio, author, or course
1.1136    raeburn  8693:    (if no quota name provided, defaults to portfolio).
                   8694: 4. crstype - official, unofficial or community, if quota name is
                   8695:    course
1.472     raeburn  8696: 
                   8697: Returns:
1.536     raeburn  8698: 1. Disk quota (in Mb) assigned to student.
                   8699: 2. (Optional) Type of setting: custom or default
                   8700:    (individually assigned or default for user's 
                   8701:    institutional status).
                   8702: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8703:    or student - types as defined in localenroll::inst_usertypes 
                   8704:    for user's domain, which determines default quota for user.
                   8705: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8706: 
                   8707: If a value has been stored in the user's environment, 
1.536     raeburn  8708: it will return that, otherwise it returns the maximal default
1.1134    raeburn  8709: defined for the user's institutional status(es) in the domain.
1.472     raeburn  8710: 
                   8711: =cut
                   8712: 
                   8713: ###############################################
                   8714: 
                   8715: 
                   8716: sub get_user_quota {
1.1136    raeburn  8717:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  8718:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8719:     if (!defined($udom)) {
                   8720:         $udom = $env{'user.domain'};
                   8721:     }
                   8722:     if (!defined($uname)) {
                   8723:         $uname = $env{'user.name'};
                   8724:     }
                   8725:     if (($udom eq '' || $uname eq '') ||
                   8726:         ($udom eq 'public') && ($uname eq 'public')) {
                   8727:         $quota = 0;
1.536     raeburn  8728:         $quotatype = 'default';
                   8729:         $defquota = 0; 
1.472     raeburn  8730:     } else {
1.536     raeburn  8731:         my $inststatus;
1.1134    raeburn  8732:         if ($quotaname eq 'course') {
                   8733:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   8734:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   8735:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   8736:             } else {
                   8737:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   8738:                 $quota = $cenv{'internal.uploadquota'};
                   8739:             }
1.536     raeburn  8740:         } else {
1.1134    raeburn  8741:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8742:                 if ($quotaname eq 'author') {
                   8743:                     $quota = $env{'environment.authorquota'};
                   8744:                 } else {
                   8745:                     $quota = $env{'environment.portfolioquota'};
                   8746:                 }
                   8747:                 $inststatus = $env{'environment.inststatus'};
                   8748:             } else {
                   8749:                 my %userenv = 
                   8750:                     &Apache::lonnet::get('environment',['portfolioquota',
                   8751:                                          'authorquota','inststatus'],$udom,$uname);
                   8752:                 my ($tmp) = keys(%userenv);
                   8753:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8754:                     if ($quotaname eq 'author') {
                   8755:                         $quota = $userenv{'authorquota'};
                   8756:                     } else {
                   8757:                         $quota = $userenv{'portfolioquota'};
                   8758:                     }
                   8759:                     $inststatus = $userenv{'inststatus'};
                   8760:                 } else {
                   8761:                     undef(%userenv);
                   8762:                 }
                   8763:             }
                   8764:         }
                   8765:         if ($quota eq '' || wantarray) {
                   8766:             if ($quotaname eq 'course') {
                   8767:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1136    raeburn  8768:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || ($crstype eq 'community')) { 
                   8769:                     $defquota = $domdefs{$crstype.'quota'};
                   8770:                 }
                   8771:                 if ($defquota eq '') {
                   8772:                     $defquota = 500;
                   8773:                 }
1.1134    raeburn  8774:             } else {
                   8775:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   8776:             }
                   8777:             if ($quota eq '') {
                   8778:                 $quota = $defquota;
                   8779:                 $quotatype = 'default';
                   8780:             } else {
                   8781:                 $quotatype = 'custom';
                   8782:             }
1.472     raeburn  8783:         }
                   8784:     }
1.536     raeburn  8785:     if (wantarray) {
                   8786:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8787:     } else {
                   8788:         return $quota;
                   8789:     }
1.472     raeburn  8790: }
                   8791: 
                   8792: ###############################################
                   8793: 
                   8794: =pod
                   8795: 
                   8796: =item * &default_quota()
                   8797: 
1.536     raeburn  8798: Retrieves default quota assigned for storage of user portfolio files,
                   8799: given an (optional) user's institutional status.
1.472     raeburn  8800: 
                   8801: Incoming parameters:
1.1142    raeburn  8802: 
1.472     raeburn  8803: 1. domain
1.536     raeburn  8804: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8805:    status types (e.g., faculty, staff, student etc.)
                   8806:    which apply to the user for whom the default is being retrieved.
                   8807:    If the institutional status string in undefined, the domain
1.1134    raeburn  8808:    default quota will be returned.
                   8809: 3.  quota name - portfolio, author, or course
                   8810:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  8811: 
                   8812: Returns:
1.1142    raeburn  8813: 
1.472     raeburn  8814: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  8815: 2. (Optional) institutional type which determined the value of the
                   8816:    default quota.
1.472     raeburn  8817: 
                   8818: If a value has been stored in the domain's configuration db,
                   8819: it will return that, otherwise it returns 20 (for backwards 
                   8820: compatibility with domains which have not set up a configuration
                   8821: db file; the original statically defined portfolio quota was 20 Mb). 
                   8822: 
1.536     raeburn  8823: If the user's status includes multiple types (e.g., staff and student),
                   8824: the largest default quota which applies to the user determines the
                   8825: default quota returned.
                   8826: 
1.472     raeburn  8827: =cut
                   8828: 
                   8829: ###############################################
                   8830: 
                   8831: 
                   8832: sub default_quota {
1.1134    raeburn  8833:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  8834:     my ($defquota,$settingstatus);
                   8835:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8836:                                             ['quotas'],$udom);
1.1134    raeburn  8837:     my $key = 'defaultquota';
                   8838:     if ($quotaname eq 'author') {
                   8839:         $key = 'authorquota';
                   8840:     }
1.622     raeburn  8841:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8842:         if ($inststatus ne '') {
1.765     raeburn  8843:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8844:             foreach my $item (@statuses) {
1.1134    raeburn  8845:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8846:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  8847:                         if ($defquota eq '') {
1.1134    raeburn  8848:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8849:                             $settingstatus = $item;
1.1134    raeburn  8850:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   8851:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8852:                             $settingstatus = $item;
                   8853:                         }
                   8854:                     }
1.1134    raeburn  8855:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  8856:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8857:                         if ($defquota eq '') {
                   8858:                             $defquota = $quotahash{'quotas'}{$item};
                   8859:                             $settingstatus = $item;
                   8860:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8861:                             $defquota = $quotahash{'quotas'}{$item};
                   8862:                             $settingstatus = $item;
                   8863:                         }
1.536     raeburn  8864:                     }
                   8865:                 }
                   8866:             }
                   8867:         }
                   8868:         if ($defquota eq '') {
1.1134    raeburn  8869:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8870:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   8871:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  8872:                 $defquota = $quotahash{'quotas'}{'default'};
                   8873:             }
1.536     raeburn  8874:             $settingstatus = 'default';
1.1139    raeburn  8875:             if ($defquota eq '') {
                   8876:                 if ($quotaname eq 'author') {
                   8877:                     $defquota = 500;
                   8878:                 }
                   8879:             }
1.536     raeburn  8880:         }
                   8881:     } else {
                   8882:         $settingstatus = 'default';
1.1134    raeburn  8883:         if ($quotaname eq 'author') {
                   8884:             $defquota = 500;
                   8885:         } else {
                   8886:             $defquota = 20;
                   8887:         }
1.536     raeburn  8888:     }
                   8889:     if (wantarray) {
                   8890:         return ($defquota,$settingstatus);
1.472     raeburn  8891:     } else {
1.536     raeburn  8892:         return $defquota;
1.472     raeburn  8893:     }
                   8894: }
                   8895: 
1.1135    raeburn  8896: ###############################################
                   8897: 
                   8898: =pod
                   8899: 
1.1136    raeburn  8900: =item * &excess_filesize_warning()
1.1135    raeburn  8901: 
                   8902: Returns warning message if upload of file to authoring space, or copying
1.1136    raeburn  8903: of existing file within authoring space will cause quota for the authoring
1.1146    raeburn  8904: space to be exceeded.
1.1136    raeburn  8905: 
                   8906: Same, if upload of a file directly to a course/community via Course Editor
1.1137    raeburn  8907: will cause quota for uploaded content for the course to be exceeded.
1.1135    raeburn  8908: 
                   8909: Inputs: 6
1.1136    raeburn  8910: 1. username or coursenum
1.1135    raeburn  8911: 2. domain
1.1136    raeburn  8912: 3. context ('author' or 'course')
1.1135    raeburn  8913: 4. filename of file for which action is being requested
                   8914: 5. filesize (kB) of file
                   8915: 6. action being taken: copy or upload.
                   8916: 
                   8917: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142    raeburn  8918:          otherwise return null.
                   8919: 
                   8920: =back
1.1135    raeburn  8921: 
                   8922: =cut
                   8923: 
1.1136    raeburn  8924: sub excess_filesize_warning {
                   8925:     my ($uname,$udom,$context,$filename,$filesize,$action) = @_;
                   8926:     my $current_disk_usage = 0;
                   8927:     my $disk_quota = &get_user_quota($uname,$udom,$context); #expressed in MB
                   8928:     if ($context eq 'author') {
                   8929:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   8930:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   8931:     } else {
                   8932:         foreach my $subdir ('docs','supplemental') {
                   8933:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   8934:         }
                   8935:     }
1.1135    raeburn  8936:     $disk_quota = int($disk_quota * 1000);
                   8937:     if (($current_disk_usage + $filesize) > $disk_quota) {
                   8938:         return '<p><span class="LC_warning">'.
                   8939:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
                   8940:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</span>'.
                   8941:                '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   8942:                             $disk_quota,$current_disk_usage).
                   8943:                '</p>';
                   8944:     }
                   8945:     return;
                   8946: }
                   8947: 
                   8948: ###############################################
                   8949: 
                   8950: 
1.1136    raeburn  8951: 
                   8952: 
1.384     raeburn  8953: sub get_secgrprole_info {
                   8954:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8955:     my %sections_count = &get_sections($cdom,$cnum);
                   8956:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8957:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8958:     my @groups = sort(keys(%curr_groups));
                   8959:     my $allroles = [];
                   8960:     my $rolehash;
                   8961:     my $accesshash = {
                   8962:                      active => 'Currently has access',
                   8963:                      future => 'Will have future access',
                   8964:                      previous => 'Previously had access',
                   8965:                   };
                   8966:     if ($needroles) {
                   8967:         $rolehash = {'all' => 'all'};
1.385     albertel 8968:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8969: 	if (&Apache::lonnet::error(%user_roles)) {
                   8970: 	    undef(%user_roles);
                   8971: 	}
                   8972:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  8973:             my ($role)=split(/\:/,$item,2);
                   8974:             if ($role eq 'cr') { next; }
                   8975:             if ($role =~ /^cr/) {
                   8976:                 $$rolehash{$role} = (split('/',$role))[3];
                   8977:             } else {
                   8978:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   8979:             }
                   8980:         }
                   8981:         foreach my $key (sort(keys(%{$rolehash}))) {
                   8982:             push(@{$allroles},$key);
                   8983:         }
                   8984:         push (@{$allroles},'st');
                   8985:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   8986:     }
                   8987:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   8988: }
                   8989: 
1.555     raeburn  8990: sub user_picker {
1.994     raeburn  8991:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  8992:     my $currdom = $dom;
                   8993:     my %curr_selected = (
                   8994:                         srchin => 'dom',
1.580     raeburn  8995:                         srchby => 'lastname',
1.555     raeburn  8996:                       );
                   8997:     my $srchterm;
1.625     raeburn  8998:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  8999:         if ($srch->{'srchby'} ne '') {
                   9000:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9001:         }
                   9002:         if ($srch->{'srchin'} ne '') {
                   9003:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9004:         }
                   9005:         if ($srch->{'srchtype'} ne '') {
                   9006:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9007:         }
                   9008:         if ($srch->{'srchdomain'} ne '') {
                   9009:             $currdom = $srch->{'srchdomain'};
                   9010:         }
                   9011:         $srchterm = $srch->{'srchterm'};
                   9012:     }
                   9013:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  9014:                     'usr'       => 'Search criteria',
1.563     raeburn  9015:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9016:                     'uname'     => 'username',
                   9017:                     'lastname'  => 'last name',
1.555     raeburn  9018:                     'lastfirst' => 'last name, first name',
1.558     albertel 9019:                     'crs'       => 'in this course',
1.576     raeburn  9020:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9021:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9022:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9023:                     'exact'     => 'is',
                   9024:                     'contains'  => 'contains',
1.569     raeburn  9025:                     'begins'    => 'begins with',
1.571     raeburn  9026:                     'youm'      => "You must include some text to search for.",
                   9027:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9028:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9029:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9030:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9031:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9032:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9033:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9034:                                        );
1.563     raeburn  9035:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9036:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9037: 
                   9038:     my @srchins = ('crs','dom','alc','instd');
                   9039: 
                   9040:     foreach my $option (@srchins) {
                   9041:         # FIXME 'alc' option unavailable until 
                   9042:         #       loncreateuser::print_user_query_page()
                   9043:         #       has been completed.
                   9044:         next if ($option eq 'alc');
1.880     raeburn  9045:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9046:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9047:         if ($curr_selected{'srchin'} eq $option) {
                   9048:             $srchinsel .= ' 
                   9049:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9050:         } else {
                   9051:             $srchinsel .= '
                   9052:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9053:         }
1.555     raeburn  9054:     }
1.563     raeburn  9055:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9056: 
                   9057:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9058:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9059:         if ($curr_selected{'srchby'} eq $option) {
                   9060:             $srchbysel .= '
                   9061:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9062:         } else {
                   9063:             $srchbysel .= '
                   9064:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9065:          }
                   9066:     }
                   9067:     $srchbysel .= "\n  </select>\n";
                   9068: 
                   9069:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9070:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9071:         if ($curr_selected{'srchtype'} eq $option) {
                   9072:             $srchtypesel .= '
                   9073:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9074:         } else {
                   9075:             $srchtypesel .= '
                   9076:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9077:         }
                   9078:     }
                   9079:     $srchtypesel .= "\n  </select>\n";
                   9080: 
1.558     albertel 9081:     my ($newuserscript,$new_user_create);
1.994     raeburn  9082:     my $context_dom = $env{'request.role.domain'};
                   9083:     if ($context eq 'requestcrs') {
                   9084:         if ($env{'form.coursedom'} ne '') { 
                   9085:             $context_dom = $env{'form.coursedom'};
                   9086:         }
                   9087:     }
1.556     raeburn  9088:     if ($forcenewuser) {
1.576     raeburn  9089:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9090:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9091:                 if ($cancreate) {
                   9092:                     $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>';
                   9093:                 } else {
1.799     bisitz   9094:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9095:                     my %usertypetext = (
                   9096:                         official   => 'institutional',
                   9097:                         unofficial => 'non-institutional',
                   9098:                     );
1.799     bisitz   9099:                     $new_user_create = '<p class="LC_warning">'
                   9100:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9101:                                       .' '
                   9102:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9103:                                           ,'<a href="'.$helplink.'">','</a>')
                   9104:                                       .'</p><br />';
1.627     raeburn  9105:                 }
1.576     raeburn  9106:             }
                   9107:         }
                   9108: 
1.556     raeburn  9109:         $newuserscript = <<"ENDSCRIPT";
                   9110: 
1.570     raeburn  9111: function setSearch(createnew,callingForm) {
1.556     raeburn  9112:     if (createnew == 1) {
1.570     raeburn  9113:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9114:             if (callingForm.srchby.options[i].value == 'uname') {
                   9115:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9116:             }
                   9117:         }
1.570     raeburn  9118:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9119:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9120: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9121:             }
                   9122:         }
1.570     raeburn  9123:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9124:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9125:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9126:             }
                   9127:         }
1.570     raeburn  9128:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9129:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9130:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9131:             }
                   9132:         }
                   9133:     }
                   9134: }
                   9135: ENDSCRIPT
1.558     albertel 9136: 
1.556     raeburn  9137:     }
                   9138: 
1.555     raeburn  9139:     my $output = <<"END_BLOCK";
1.556     raeburn  9140: <script type="text/javascript">
1.824     bisitz   9141: // <![CDATA[
1.570     raeburn  9142: function validateEntry(callingForm) {
1.558     albertel 9143: 
1.556     raeburn  9144:     var checkok = 1;
1.558     albertel 9145:     var srchin;
1.570     raeburn  9146:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9147: 	if ( callingForm.srchin[i].checked ) {
                   9148: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9149: 	}
                   9150:     }
                   9151: 
1.570     raeburn  9152:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9153:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9154:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9155:     var srchterm =  callingForm.srchterm.value;
                   9156:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9157:     var msg = "";
                   9158: 
                   9159:     if (srchterm == "") {
                   9160:         checkok = 0;
1.571     raeburn  9161:         msg += "$lt{'youm'}\\n";
1.556     raeburn  9162:     }
                   9163: 
1.569     raeburn  9164:     if (srchtype== 'begins') {
                   9165:         if (srchterm.length < 2) {
                   9166:             checkok = 0;
1.571     raeburn  9167:             msg += "$lt{'thte'}\\n";
1.569     raeburn  9168:         }
                   9169:     }
                   9170: 
1.556     raeburn  9171:     if (srchtype== 'contains') {
                   9172:         if (srchterm.length < 3) {
                   9173:             checkok = 0;
1.571     raeburn  9174:             msg += "$lt{'thet'}\\n";
1.556     raeburn  9175:         }
                   9176:     }
                   9177:     if (srchin == 'instd') {
                   9178:         if (srchdomain == '') {
                   9179:             checkok = 0;
1.571     raeburn  9180:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  9181:         }
                   9182:     }
                   9183:     if (srchin == 'dom') {
                   9184:         if (srchdomain == '') {
                   9185:             checkok = 0;
1.571     raeburn  9186:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  9187:         }
                   9188:     }
                   9189:     if (srchby == 'lastfirst') {
                   9190:         if (srchterm.indexOf(",") == -1) {
                   9191:             checkok = 0;
1.571     raeburn  9192:             msg += "$lt{'whus'}\\n";
1.556     raeburn  9193:         }
                   9194:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9195:             checkok = 0;
1.571     raeburn  9196:             msg += "$lt{'whse'}\\n";
1.556     raeburn  9197:         }
                   9198:     }
                   9199:     if (checkok == 0) {
1.571     raeburn  9200:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  9201:         return;
                   9202:     }
                   9203:     if (checkok == 1) {
1.570     raeburn  9204:         callingForm.submit();
1.556     raeburn  9205:     }
                   9206: }
                   9207: 
                   9208: $newuserscript
                   9209: 
1.824     bisitz   9210: // ]]>
1.556     raeburn  9211: </script>
1.558     albertel 9212: 
                   9213: $new_user_create
                   9214: 
1.555     raeburn  9215: END_BLOCK
1.558     albertel 9216: 
1.876     raeburn  9217:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   9218:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   9219:                $domform.
                   9220:                &Apache::lonhtmlcommon::row_closure().
                   9221:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   9222:                $srchbysel.
                   9223:                $srchtypesel. 
                   9224:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9225:                $srchinsel.
                   9226:                &Apache::lonhtmlcommon::row_closure(1). 
                   9227:                &Apache::lonhtmlcommon::end_pick_box().
                   9228:                '<br />';
1.555     raeburn  9229:     return $output;
                   9230: }
                   9231: 
1.612     raeburn  9232: sub user_rule_check {
1.615     raeburn  9233:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  9234:     my $response;
                   9235:     if (ref($usershash) eq 'HASH') {
                   9236:         foreach my $user (keys(%{$usershash})) {
                   9237:             my ($uname,$udom) = split(/:/,$user);
                   9238:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  9239:             my ($id,$newuser);
1.612     raeburn  9240:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  9241:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  9242:                 $id = $usershash->{$user}->{'id'};
                   9243:             }
                   9244:             my $inst_response;
                   9245:             if (ref($checks) eq 'HASH') {
                   9246:                 if (defined($checks->{'username'})) {
1.615     raeburn  9247:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  9248:                         &Apache::lonnet::get_instuser($udom,$uname);
                   9249:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  9250:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  9251:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   9252:                 }
1.615     raeburn  9253:             } else {
                   9254:                 ($inst_response,%{$inst_results->{$user}}) =
                   9255:                     &Apache::lonnet::get_instuser($udom,$uname);
                   9256:                 return;
1.612     raeburn  9257:             }
1.615     raeburn  9258:             if (!$got_rules->{$udom}) {
1.612     raeburn  9259:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9260:                                                   ['usercreation'],$udom);
                   9261:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  9262:                     foreach my $item ('username','id') {
1.612     raeburn  9263:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9264:                             $$curr_rules{$udom}{$item} = 
                   9265:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  9266:                         }
                   9267:                     }
                   9268:                 }
1.615     raeburn  9269:                 $got_rules->{$udom} = 1;  
1.585     raeburn  9270:             }
1.612     raeburn  9271:             foreach my $item (keys(%{$checks})) {
                   9272:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9273:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9274:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   9275:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   9276:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9277:                                 if ($rule_check{$rule}) {
                   9278:                                     $$rulematch{$user}{$item} = $rule;
                   9279:                                     if ($inst_response eq 'ok') {
1.615     raeburn  9280:                                         if (ref($inst_results) eq 'HASH') {
                   9281:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9282:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9283:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   9284:                                                 }
1.612     raeburn  9285:                                             }
                   9286:                                         }
1.615     raeburn  9287:                                     }
                   9288:                                     last;
1.585     raeburn  9289:                                 }
                   9290:                             }
                   9291:                         }
                   9292:                     }
                   9293:                 }
                   9294:             }
                   9295:         }
                   9296:     }
1.612     raeburn  9297:     return;
                   9298: }
                   9299: 
                   9300: sub user_rule_formats {
                   9301:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9302:     my %text = ( 
                   9303:                  'username' => 'Usernames',
                   9304:                  'id'       => 'IDs',
                   9305:                );
                   9306:     my $output;
                   9307:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9308:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9309:         if (@{$ruleorder} > 0) {
1.1102    raeburn  9310:             $output = '<br />'.
                   9311:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9312:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9313:                       ' <ul>';
1.612     raeburn  9314:             foreach my $rule (@{$ruleorder}) {
                   9315:                 if (ref($curr_rules) eq 'ARRAY') {
                   9316:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9317:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9318:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9319:                                         $rules->{$rule}{'desc'}.'</li>';
                   9320:                         }
                   9321:                     }
                   9322:                 }
                   9323:             }
                   9324:             $output .= '</ul>';
                   9325:         }
                   9326:     }
                   9327:     return $output;
                   9328: }
                   9329: 
                   9330: sub instrule_disallow_msg {
1.615     raeburn  9331:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9332:     my $response;
                   9333:     my %text = (
                   9334:                   item   => 'username',
                   9335:                   items  => 'usernames',
                   9336:                   match  => 'matches',
                   9337:                   do     => 'does',
                   9338:                   action => 'a username',
                   9339:                   one    => 'one',
                   9340:                );
                   9341:     if ($count > 1) {
                   9342:         $text{'item'} = 'usernames';
                   9343:         $text{'match'} ='match';
                   9344:         $text{'do'} = 'do';
                   9345:         $text{'action'} = 'usernames',
                   9346:         $text{'one'} = 'ones';
                   9347:     }
                   9348:     if ($checkitem eq 'id') {
                   9349:         $text{'items'} = 'IDs';
                   9350:         $text{'item'} = 'ID';
                   9351:         $text{'action'} = 'an ID';
1.615     raeburn  9352:         if ($count > 1) {
                   9353:             $text{'item'} = 'IDs';
                   9354:             $text{'action'} = 'IDs';
                   9355:         }
1.612     raeburn  9356:     }
1.674     bisitz   9357:     $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  9358:     if ($mode eq 'upload') {
                   9359:         if ($checkitem eq 'username') {
                   9360:             $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'}.");
                   9361:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9362:             $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  9363:         }
1.669     raeburn  9364:     } elsif ($mode eq 'selfcreate') {
                   9365:         if ($checkitem eq 'id') {
                   9366:             $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.");
                   9367:         }
1.615     raeburn  9368:     } else {
                   9369:         if ($checkitem eq 'username') {
                   9370:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9371:         } elsif ($checkitem eq 'id') {
                   9372:             $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.");
                   9373:         }
1.612     raeburn  9374:     }
                   9375:     return $response;
1.585     raeburn  9376: }
                   9377: 
1.624     raeburn  9378: sub personal_data_fieldtitles {
                   9379:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9380:                         id => 'Student/Employee ID',
                   9381:                         permanentemail => 'E-mail address',
                   9382:                         lastname => 'Last Name',
                   9383:                         firstname => 'First Name',
                   9384:                         middlename => 'Middle Name',
                   9385:                         generation => 'Generation',
                   9386:                         gen => 'Generation',
1.765     raeburn  9387:                         inststatus => 'Affiliation',
1.624     raeburn  9388:                    );
                   9389:     return %fieldtitles;
                   9390: }
                   9391: 
1.642     raeburn  9392: sub sorted_inst_types {
                   9393:     my ($dom) = @_;
                   9394:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9395:     my $othertitle = &mt('All users');
                   9396:     if ($env{'request.course.id'}) {
1.668     raeburn  9397:         $othertitle  = &mt('Any users');
1.642     raeburn  9398:     }
                   9399:     my @types;
                   9400:     if (ref($order) eq 'ARRAY') {
                   9401:         @types = @{$order};
                   9402:     }
                   9403:     if (@types == 0) {
                   9404:         if (ref($usertypes) eq 'HASH') {
                   9405:             @types = sort(keys(%{$usertypes}));
                   9406:         }
                   9407:     }
                   9408:     if (keys(%{$usertypes}) > 0) {
                   9409:         $othertitle = &mt('Other users');
                   9410:     }
                   9411:     return ($othertitle,$usertypes,\@types);
                   9412: }
                   9413: 
1.645     raeburn  9414: sub get_institutional_codes {
                   9415:     my ($settings,$allcourses,$LC_code) = @_;
                   9416: # Get complete list of course sections to update
                   9417:     my @currsections = ();
                   9418:     my @currxlists = ();
                   9419:     my $coursecode = $$settings{'internal.coursecode'};
                   9420: 
                   9421:     if ($$settings{'internal.sectionnums'} ne '') {
                   9422:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9423:     }
                   9424: 
                   9425:     if ($$settings{'internal.crosslistings'} ne '') {
                   9426:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9427:     }
                   9428: 
                   9429:     if (@currxlists > 0) {
                   9430:         foreach (@currxlists) {
                   9431:             if (m/^([^:]+):(\w*)$/) {
                   9432:                 unless (grep/^$1$/,@{$allcourses}) {
                   9433:                     push @{$allcourses},$1;
                   9434:                     $$LC_code{$1} = $2;
                   9435:                 }
                   9436:             }
                   9437:         }
                   9438:     }
                   9439:  
                   9440:     if (@currsections > 0) {
                   9441:         foreach (@currsections) {
                   9442:             if (m/^(\w+):(\w*)$/) {
                   9443:                 my $sec = $coursecode.$1;
                   9444:                 my $lc_sec = $2;
                   9445:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9446:                     push @{$allcourses},$sec;
                   9447:                     $$LC_code{$sec} = $lc_sec;
                   9448:                 }
                   9449:             }
                   9450:         }
                   9451:     }
                   9452:     return;
                   9453: }
                   9454: 
1.971     raeburn  9455: sub get_standard_codeitems {
                   9456:     return ('Year','Semester','Department','Number','Section');
                   9457: }
                   9458: 
1.112     bowersj2 9459: =pod
                   9460: 
1.780     raeburn  9461: =head1 Slot Helpers
                   9462: 
                   9463: =over 4
                   9464: 
                   9465: =item * sorted_slots()
                   9466: 
1.1040    raeburn  9467: Sorts an array of slot names in order of an optional sort key,
                   9468: default sort is by slot start time (earliest first). 
1.780     raeburn  9469: 
                   9470: Inputs:
                   9471: 
                   9472: =over 4
                   9473: 
                   9474: slotsarr  - Reference to array of unsorted slot names.
                   9475: 
                   9476: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9477: 
1.1040    raeburn  9478: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9479: 
1.549     albertel 9480: =back
                   9481: 
1.780     raeburn  9482: Returns:
                   9483: 
                   9484: =over 4
                   9485: 
1.1040    raeburn  9486: sorted   - An array of slot names sorted by a specified sort key 
                   9487:            (default sort key is start time of the slot).
1.780     raeburn  9488: 
                   9489: =back
                   9490: 
                   9491: =cut
                   9492: 
                   9493: 
                   9494: sub sorted_slots {
1.1040    raeburn  9495:     my ($slotsarr,$slots,$sortkey) = @_;
                   9496:     if ($sortkey eq '') {
                   9497:         $sortkey = 'starttime';
                   9498:     }
1.780     raeburn  9499:     my @sorted;
                   9500:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9501:         @sorted =
                   9502:             sort {
                   9503:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9504:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9505:                      }
                   9506:                      if (ref($slots->{$a})) { return -1;}
                   9507:                      if (ref($slots->{$b})) { return 1;}
                   9508:                      return 0;
                   9509:                  } @{$slotsarr};
                   9510:     }
                   9511:     return @sorted;
                   9512: }
                   9513: 
1.1040    raeburn  9514: =pod
                   9515: 
                   9516: =item * get_future_slots()
                   9517: 
                   9518: Inputs:
                   9519: 
                   9520: =over 4
                   9521: 
                   9522: cnum - course number
                   9523: 
                   9524: cdom - course domain
                   9525: 
                   9526: now - current UNIX time
                   9527: 
                   9528: symb - optional symb
                   9529: 
                   9530: =back
                   9531: 
                   9532: Returns:
                   9533: 
                   9534: =over 4
                   9535: 
                   9536: sorted_reservable - ref to array of student_schedulable slots currently 
                   9537:                     reservable, ordered by end date of reservation period.
                   9538: 
                   9539: reservable_now - ref to hash of student_schedulable slots currently
                   9540:                  reservable.
                   9541: 
                   9542:     Keys in inner hash are:
                   9543:     (a) symb: either blank or symb to which slot use is restricted.
                   9544:     (b) endreserve: end date of reservation period. 
                   9545: 
                   9546: sorted_future - ref to array of student_schedulable slots reservable in
                   9547:                 the future, ordered by start date of reservation period.
                   9548: 
                   9549: future_reservable - ref to hash of student_schedulable slots reservable
                   9550:                     in the future.
                   9551: 
                   9552:     Keys in inner hash are:
                   9553:     (a) symb: either blank or symb to which slot use is restricted.
                   9554:     (b) startreserve:  start date of reservation period.
                   9555: 
                   9556: =back
                   9557: 
                   9558: =cut
                   9559: 
                   9560: sub get_future_slots {
                   9561:     my ($cnum,$cdom,$now,$symb) = @_;
                   9562:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9563:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9564:     foreach my $slot (keys(%slots)) {
                   9565:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9566:         if ($symb) {
                   9567:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9568:                      ($slots{$slot}->{'symb'} ne $symb));
                   9569:         }
                   9570:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9571:             ($slots{$slot}->{'endtime'} > $now)) {
                   9572:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9573:                 my $userallowed = 0;
                   9574:                 if ($slots{$slot}->{'allowedsections'}) {
                   9575:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9576:                     if (!defined($env{'request.role.sec'})
                   9577:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9578:                         $userallowed=1;
                   9579:                     } else {
                   9580:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9581:                             $userallowed=1;
                   9582:                         }
                   9583:                     }
                   9584:                     unless ($userallowed) {
                   9585:                         if (defined($env{'request.course.groups'})) {
                   9586:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9587:                             foreach my $group (@groups) {
                   9588:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9589:                                     $userallowed=1;
                   9590:                                     last;
                   9591:                                 }
                   9592:                             }
                   9593:                         }
                   9594:                     }
                   9595:                 }
                   9596:                 if ($slots{$slot}->{'allowedusers'}) {
                   9597:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9598:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9599:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9600:                         $userallowed = 1;
                   9601:                     }
                   9602:                 }
                   9603:                 next unless($userallowed);
                   9604:             }
                   9605:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9606:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9607:             my $symb = $slots{$slot}->{'symb'};
                   9608:             if (($startreserve < $now) &&
                   9609:                 (!$endreserve || $endreserve > $now)) {
                   9610:                 my $lastres = $endreserve;
                   9611:                 if (!$lastres) {
                   9612:                     $lastres = $slots{$slot}->{'starttime'};
                   9613:                 }
                   9614:                 $reservable_now{$slot} = {
                   9615:                                            symb       => $symb,
                   9616:                                            endreserve => $lastres
                   9617:                                          };
                   9618:             } elsif (($startreserve > $now) &&
                   9619:                      (!$endreserve || $endreserve > $startreserve)) {
                   9620:                 $future_reservable{$slot} = {
                   9621:                                               symb         => $symb,
                   9622:                                               startreserve => $startreserve
                   9623:                                             };
                   9624:             }
                   9625:         }
                   9626:     }
                   9627:     my @unsorted_reservable = keys(%reservable_now);
                   9628:     if (@unsorted_reservable > 0) {
                   9629:         @sorted_reservable = 
                   9630:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9631:     }
                   9632:     my @unsorted_future = keys(%future_reservable);
                   9633:     if (@unsorted_future > 0) {
                   9634:         @sorted_future =
                   9635:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9636:     }
                   9637:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9638: }
1.780     raeburn  9639: 
                   9640: =pod
                   9641: 
1.1057    foxr     9642: =back
                   9643: 
1.549     albertel 9644: =head1 HTTP Helpers
                   9645: 
                   9646: =over 4
                   9647: 
1.648     raeburn  9648: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9649: 
1.258     albertel 9650: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9651: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9652: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9653: 
                   9654: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9655: $possible_names is an ref to an array of form element names.  As an example:
                   9656: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9657: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9658: 
                   9659: =cut
1.1       albertel 9660: 
1.6       albertel 9661: sub get_unprocessed_cgi {
1.25      albertel 9662:   my ($query,$possible_names)= @_;
1.26      matthew  9663:   # $Apache::lonxml::debug=1;
1.356     albertel 9664:   foreach my $pair (split(/&/,$query)) {
                   9665:     my ($name, $value) = split(/=/,$pair);
1.369     www      9666:     $name = &unescape($name);
1.25      albertel 9667:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9668:       $value =~ tr/+/ /;
                   9669:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9670:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9671:     }
1.16      harris41 9672:   }
1.6       albertel 9673: }
                   9674: 
1.112     bowersj2 9675: =pod
                   9676: 
1.648     raeburn  9677: =item * &cacheheader() 
1.112     bowersj2 9678: 
                   9679: returns cache-controlling header code
                   9680: 
                   9681: =cut
                   9682: 
1.7       albertel 9683: sub cacheheader {
1.258     albertel 9684:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9685:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9686:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9687:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9688:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9689:     return $output;
1.7       albertel 9690: }
                   9691: 
1.112     bowersj2 9692: =pod
                   9693: 
1.648     raeburn  9694: =item * &no_cache($r) 
1.112     bowersj2 9695: 
                   9696: specifies header code to not have cache
                   9697: 
                   9698: =cut
                   9699: 
1.9       albertel 9700: sub no_cache {
1.216     albertel 9701:     my ($r) = @_;
                   9702:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9703: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9704:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9705:     $r->no_cache(1);
                   9706:     $r->header_out("Expires" => $date);
                   9707:     $r->header_out("Pragma" => "no-cache");
1.123     www      9708: }
                   9709: 
                   9710: sub content_type {
1.181     albertel 9711:     my ($r,$type,$charset) = @_;
1.299     foxr     9712:     if ($r) {
                   9713: 	#  Note that printout.pl calls this with undef for $r.
                   9714: 	&no_cache($r);
                   9715:     }
1.258     albertel 9716:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9717:     unless ($charset) {
                   9718: 	$charset=&Apache::lonlocal::current_encoding;
                   9719:     }
                   9720:     if ($charset) { $type.='; charset='.$charset; }
                   9721:     if ($r) {
                   9722: 	$r->content_type($type);
                   9723:     } else {
                   9724: 	print("Content-type: $type\n\n");
                   9725:     }
1.9       albertel 9726: }
1.25      albertel 9727: 
1.112     bowersj2 9728: =pod
                   9729: 
1.648     raeburn  9730: =item * &add_to_env($name,$value) 
1.112     bowersj2 9731: 
1.258     albertel 9732: adds $name to the %env hash with value
1.112     bowersj2 9733: $value, if $name already exists, the entry is converted to an array
                   9734: reference and $value is added to the array.
                   9735: 
                   9736: =cut
                   9737: 
1.25      albertel 9738: sub add_to_env {
                   9739:   my ($name,$value)=@_;
1.258     albertel 9740:   if (defined($env{$name})) {
                   9741:     if (ref($env{$name})) {
1.25      albertel 9742:       #already have multiple values
1.258     albertel 9743:       push(@{ $env{$name} },$value);
1.25      albertel 9744:     } else {
                   9745:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9746:       my $first=$env{$name};
                   9747:       undef($env{$name});
                   9748:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9749:     }
                   9750:   } else {
1.258     albertel 9751:     $env{$name}=$value;
1.25      albertel 9752:   }
1.31      albertel 9753: }
1.149     albertel 9754: 
                   9755: =pod
                   9756: 
1.648     raeburn  9757: =item * &get_env_multiple($name) 
1.149     albertel 9758: 
1.258     albertel 9759: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9760: values may be defined and end up as an array ref.
                   9761: 
                   9762: returns an array of values
                   9763: 
                   9764: =cut
                   9765: 
                   9766: sub get_env_multiple {
                   9767:     my ($name) = @_;
                   9768:     my @values;
1.258     albertel 9769:     if (defined($env{$name})) {
1.149     albertel 9770:         # exists is it an array
1.258     albertel 9771:         if (ref($env{$name})) {
                   9772:             @values=@{ $env{$name} };
1.149     albertel 9773:         } else {
1.258     albertel 9774:             $values[0]=$env{$name};
1.149     albertel 9775:         }
                   9776:     }
                   9777:     return(@values);
                   9778: }
                   9779: 
1.660     raeburn  9780: sub ask_for_embedded_content {
                   9781:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9782:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  9783:         %currsubfile,%unused,$rem);
1.1071    raeburn  9784:     my $counter = 0;
                   9785:     my $numnew = 0;
1.987     raeburn  9786:     my $numremref = 0;
                   9787:     my $numinvalid = 0;
                   9788:     my $numpathchg = 0;
                   9789:     my $numexisting = 0;
1.1071    raeburn  9790:     my $numunused = 0;
                   9791:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156    raeburn  9792:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  9793:     my $heading = &mt('Upload embedded files');
                   9794:     my $buttontext = &mt('Upload');
                   9795: 
1.1085    raeburn  9796:     if ($env{'request.course.id'}) {
1.1123    raeburn  9797:         if ($actionurl eq '/adm/dependencies') {
                   9798:             $navmap = Apache::lonnavmaps::navmap->new();
                   9799:         }
                   9800:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9801:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085    raeburn  9802:     }
1.1123    raeburn  9803:     if (($actionurl eq '/adm/portfolio') || 
                   9804:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  9805:         my $current_path='/';
                   9806:         if ($env{'form.currentpath'}) {
                   9807:             $current_path = $env{'form.currentpath'};
                   9808:         }
                   9809:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123    raeburn  9810:             $udom = $cdom;
                   9811:             $uname = $cnum;
1.984     raeburn  9812:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9813:         } else {
                   9814:             $udom = $env{'user.domain'};
                   9815:             $uname = $env{'user.name'};
                   9816:             $url = '/userfiles/portfolio';
                   9817:         }
1.987     raeburn  9818:         $toplevel = $url.'/';
1.984     raeburn  9819:         $url .= $current_path;
                   9820:         $getpropath = 1;
1.987     raeburn  9821:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9822:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9823:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9824:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9825:         $toplevel = $url;
1.984     raeburn  9826:         if ($rest ne '') {
1.987     raeburn  9827:             $url .= $rest;
                   9828:         }
                   9829:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9830:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9831:             $url = $args->{'docs_url'};
                   9832:             $toplevel = $url;
1.1084    raeburn  9833:             if ($args->{'context'} eq 'paste') {
                   9834:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9835:                 ($path) = 
                   9836:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9837:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9838:                 $fileloc =~ s{^/}{};
                   9839:             }
1.1071    raeburn  9840:         }
1.1084    raeburn  9841:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  9842:         if ($env{'request.course.id'} ne '') {
                   9843:             if (ref($args) eq 'HASH') {
                   9844:                 $url = $args->{'docs_url'};
                   9845:                 $title = $args->{'docs_title'};
1.1126    raeburn  9846:                 $toplevel = $url; 
                   9847:                 unless ($toplevel =~ m{^/}) {
                   9848:                     $toplevel = "/$url";
                   9849:                 }
1.1085    raeburn  9850:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126    raeburn  9851:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   9852:                     $path = $1;
                   9853:                 } else {
                   9854:                     ($path) =
                   9855:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9856:                 }
1.1071    raeburn  9857:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9858:                 $fileloc =~ s{^/}{};
                   9859:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9860:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9861:             }
1.987     raeburn  9862:         }
1.1123    raeburn  9863:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9864:         $udom = $cdom;
                   9865:         $uname = $cnum;
                   9866:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   9867:         $toplevel = $url;
                   9868:         $path = $url;
                   9869:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   9870:         $fileloc =~ s{^/}{};
1.987     raeburn  9871:     }
1.1126    raeburn  9872:     foreach my $file (keys(%{$allfiles})) {
                   9873:         my $embed_file;
                   9874:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   9875:             $embed_file = $1;
                   9876:         } else {
                   9877:             $embed_file = $file;
                   9878:         }
1.1158  ! raeburn  9879:         my ($absolutepath,$cleaned_file);
        !          9880:         if ($embed_file =~ m{^\w+://}) {
        !          9881:             $cleaned_file = $embed_file;
1.1147    raeburn  9882:             $newfiles{$cleaned_file} = 1;
                   9883:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9884:         } else {
1.1158  ! raeburn  9885:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  9886:             if ($embed_file =~ m{^/}) {
                   9887:                 $absolutepath = $embed_file;
                   9888:             }
1.1147    raeburn  9889:             if ($cleaned_file =~ m{/}) {
                   9890:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  9891:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9892:                 my $item = $fname;
                   9893:                 if ($path ne '') {
                   9894:                     $item = $path.'/'.$fname;
                   9895:                     $subdependencies{$path}{$fname} = 1;
                   9896:                 } else {
                   9897:                     $dependencies{$item} = 1;
                   9898:                 }
                   9899:                 if ($absolutepath) {
                   9900:                     $mapping{$item} = $absolutepath;
                   9901:                 } else {
                   9902:                     $mapping{$item} = $embed_file;
                   9903:                 }
                   9904:             } else {
                   9905:                 $dependencies{$embed_file} = 1;
                   9906:                 if ($absolutepath) {
1.1147    raeburn  9907:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  9908:                 } else {
1.1147    raeburn  9909:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9910:                 }
                   9911:             }
1.984     raeburn  9912:         }
                   9913:     }
1.1071    raeburn  9914:     my $dirptr = 16384;
1.984     raeburn  9915:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9916:         $currsubfile{$path} = {};
1.1123    raeburn  9917:         if (($actionurl eq '/adm/portfolio') || 
                   9918:             ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9919:             my ($sublistref,$listerror) =
                   9920:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9921:             if (ref($sublistref) eq 'ARRAY') {
                   9922:                 foreach my $line (@{$sublistref}) {
                   9923:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9924:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9925:                 }
1.984     raeburn  9926:             }
1.987     raeburn  9927:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9928:             if (opendir(my $dir,$url.'/'.$path)) {
                   9929:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9930:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9931:             }
1.1084    raeburn  9932:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9933:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  9934:                   ($args->{'context'} eq 'paste')) ||
                   9935:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  9936:             if ($env{'request.course.id'} ne '') {
1.1123    raeburn  9937:                 my $dir;
                   9938:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9939:                     $dir = $fileloc;
                   9940:                 } else {
                   9941:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9942:                 }
1.1071    raeburn  9943:                 if ($dir ne '') {
                   9944:                     my ($sublistref,$listerror) =
                   9945:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9946:                     if (ref($sublistref) eq 'ARRAY') {
                   9947:                         foreach my $line (@{$sublistref}) {
                   9948:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9949:                                 undef,$mtime)=split(/\&/,$line,12);
                   9950:                             unless (($testdir&$dirptr) ||
                   9951:                                     ($file_name =~ /^\.\.?$/)) {
                   9952:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9953:                             }
                   9954:                         }
                   9955:                     }
                   9956:                 }
1.984     raeburn  9957:             }
                   9958:         }
                   9959:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  9960:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  9961:                 my $item = $path.'/'.$file;
                   9962:                 unless ($mapping{$item} eq $item) {
                   9963:                     $pathchanges{$item} = 1;
                   9964:                 }
                   9965:                 $existing{$item} = 1;
                   9966:                 $numexisting ++;
                   9967:             } else {
                   9968:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  9969:             }
                   9970:         }
1.1071    raeburn  9971:         if ($actionurl eq '/adm/dependencies') {
                   9972:             foreach my $path (keys(%currsubfile)) {
                   9973:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   9974:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   9975:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  9976:                              next if (($rem ne '') &&
                   9977:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   9978:                                        (ref($navmap) &&
                   9979:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   9980:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9981:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  9982:                              $unused{$path.'/'.$file} = 1; 
                   9983:                          }
                   9984:                     }
                   9985:                 }
                   9986:             }
                   9987:         }
1.984     raeburn  9988:     }
1.987     raeburn  9989:     my %currfile;
1.1123    raeburn  9990:     if (($actionurl eq '/adm/portfolio') ||
                   9991:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9992:         my ($dirlistref,$listerror) =
                   9993:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   9994:         if (ref($dirlistref) eq 'ARRAY') {
                   9995:             foreach my $line (@{$dirlistref}) {
                   9996:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   9997:                 $currfile{$file_name} = 1;
                   9998:             }
1.984     raeburn  9999:         }
1.987     raeburn  10000:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10001:         if (opendir(my $dir,$url)) {
1.987     raeburn  10002:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10003:             map {$currfile{$_} = 1;} @dir_list;
                   10004:         }
1.1084    raeburn  10005:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10006:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  10007:               ($args->{'context'} eq 'paste')) ||
                   10008:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10009:         if ($env{'request.course.id'} ne '') {
                   10010:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10011:             if ($dir ne '') {
                   10012:                 my ($dirlistref,$listerror) =
                   10013:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10014:                 if (ref($dirlistref) eq 'ARRAY') {
                   10015:                     foreach my $line (@{$dirlistref}) {
                   10016:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10017:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10018:                         unless (($testdir&$dirptr) ||
                   10019:                                 ($file_name =~ /^\.\.?$/)) {
                   10020:                             $currfile{$file_name} = [$size,$mtime];
                   10021:                         }
                   10022:                     }
                   10023:                 }
                   10024:             }
                   10025:         }
1.984     raeburn  10026:     }
                   10027:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10028:         if (exists($currfile{$file})) {
1.987     raeburn  10029:             unless ($mapping{$file} eq $file) {
                   10030:                 $pathchanges{$file} = 1;
                   10031:             }
                   10032:             $existing{$file} = 1;
                   10033:             $numexisting ++;
                   10034:         } else {
1.984     raeburn  10035:             $newfiles{$file} = 1;
                   10036:         }
                   10037:     }
1.1071    raeburn  10038:     foreach my $file (keys(%currfile)) {
                   10039:         unless (($file eq $filename) ||
                   10040:                 ($file eq $filename.'.bak') ||
                   10041:                 ($dependencies{$file})) {
1.1085    raeburn  10042:             if ($actionurl eq '/adm/dependencies') {
1.1126    raeburn  10043:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10044:                     next if (($rem ne '') &&
                   10045:                              (($env{"httpref.$rem".$file} ne '') ||
                   10046:                               (ref($navmap) &&
                   10047:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10048:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10049:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10050:                 }
1.1085    raeburn  10051:             }
1.1071    raeburn  10052:             $unused{$file} = 1;
                   10053:         }
                   10054:     }
1.1084    raeburn  10055:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10056:         ($args->{'context'} eq 'paste')) {
                   10057:         $counter = scalar(keys(%existing));
                   10058:         $numpathchg = scalar(keys(%pathchanges));
1.1123    raeburn  10059:         return ($output,$counter,$numpathchg,\%existing);
                   10060:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
                   10061:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10062:         $counter = scalar(keys(%existing));
                   10063:         $numpathchg = scalar(keys(%pathchanges));
                   10064:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084    raeburn  10065:     }
1.984     raeburn  10066:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10067:         if ($actionurl eq '/adm/dependencies') {
                   10068:             next if ($embed_file =~ m{^\w+://});
                   10069:         }
1.660     raeburn  10070:         $upload_output .= &start_data_table_row().
1.1123    raeburn  10071:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10072:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10073:         unless ($mapping{$embed_file} eq $embed_file) {
1.1123    raeburn  10074:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10075:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10076:         }
1.1123    raeburn  10077:         $upload_output .= '</td>';
1.1071    raeburn  10078:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1123    raeburn  10079:             $upload_output.='<td align="right">'.
                   10080:                             '<span class="LC_info LC_fontsize_medium">'.
                   10081:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10082:             $numremref++;
1.660     raeburn  10083:         } elsif ($args->{'error_on_invalid_names'}
                   10084:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123    raeburn  10085:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10086:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10087:             $numinvalid++;
1.660     raeburn  10088:         } else {
1.1123    raeburn  10089:             $upload_output .= '<td>'.
                   10090:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10091:                                                      $embed_file,\%mapping,
1.1071    raeburn  10092:                                                      $allfiles,$codebase,'upload');
                   10093:             $counter ++;
                   10094:             $numnew ++;
1.987     raeburn  10095:         }
                   10096:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10097:     }
                   10098:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10099:         if ($actionurl eq '/adm/dependencies') {
                   10100:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10101:             $modify_output .= &start_data_table_row().
                   10102:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10103:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10104:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10105:                               '<td>'.$size.'</td>'.
                   10106:                               '<td>'.$mtime.'</td>'.
                   10107:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10108:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10109:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10110:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10111:                               &embedded_file_element('upload_embedded',$counter,
                   10112:                                                      $embed_file,\%mapping,
                   10113:                                                      $allfiles,$codebase,'modify').
                   10114:                               '</div></td>'.
                   10115:                               &end_data_table_row()."\n";
                   10116:             $counter ++;
                   10117:         } else {
                   10118:             $upload_output .= &start_data_table_row().
1.1123    raeburn  10119:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10120:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10121:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10122:                               &Apache::loncommon::end_data_table_row()."\n";
                   10123:         }
                   10124:     }
                   10125:     my $delidx = $counter;
                   10126:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10127:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10128:         $delete_output .= &start_data_table_row().
                   10129:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10130:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10131:                           '<td>'.$size.'</td>'.
                   10132:                           '<td>'.$mtime.'</td>'.
                   10133:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10134:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10135:                           &embedded_file_element('upload_embedded',$delidx,
                   10136:                                                  $oldfile,\%mapping,$allfiles,
                   10137:                                                  $codebase,'delete').'</td>'.
                   10138:                           &end_data_table_row()."\n"; 
                   10139:         $numunused ++;
                   10140:         $delidx ++;
1.987     raeburn  10141:     }
                   10142:     if ($upload_output) {
                   10143:         $upload_output = &start_data_table().
                   10144:                          $upload_output.
                   10145:                          &end_data_table()."\n";
                   10146:     }
1.1071    raeburn  10147:     if ($modify_output) {
                   10148:         $modify_output = &start_data_table().
                   10149:                          &start_data_table_header_row().
                   10150:                          '<th>'.&mt('File').'</th>'.
                   10151:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10152:                          '<th>'.&mt('Modified').'</th>'.
                   10153:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10154:                          &end_data_table_header_row().
                   10155:                          $modify_output.
                   10156:                          &end_data_table()."\n";
                   10157:     }
                   10158:     if ($delete_output) {
                   10159:         $delete_output = &start_data_table().
                   10160:                          &start_data_table_header_row().
                   10161:                          '<th>'.&mt('File').'</th>'.
                   10162:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10163:                          '<th>'.&mt('Modified').'</th>'.
                   10164:                          '<th>'.&mt('Delete?').'</th>'.
                   10165:                          &end_data_table_header_row().
                   10166:                          $delete_output.
                   10167:                          &end_data_table()."\n";
                   10168:     }
1.987     raeburn  10169:     my $applies = 0;
                   10170:     if ($numremref) {
                   10171:         $applies ++;
                   10172:     }
                   10173:     if ($numinvalid) {
                   10174:         $applies ++;
                   10175:     }
                   10176:     if ($numexisting) {
                   10177:         $applies ++;
                   10178:     }
1.1071    raeburn  10179:     if ($counter || $numunused) {
1.987     raeburn  10180:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10181:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10182:                   $state.'<h3>'.$heading.'</h3>'; 
                   10183:         if ($actionurl eq '/adm/dependencies') {
                   10184:             if ($numnew) {
                   10185:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10186:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10187:                            $upload_output.'<br />'."\n";
                   10188:             }
                   10189:             if ($numexisting) {
                   10190:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10191:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10192:                            $modify_output.'<br />'."\n";
                   10193:                            $buttontext = &mt('Save changes');
                   10194:             }
                   10195:             if ($numunused) {
                   10196:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10197:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10198:                            $delete_output.'<br />'."\n";
                   10199:                            $buttontext = &mt('Save changes');
                   10200:             }
                   10201:         } else {
                   10202:             $output .= $upload_output.'<br />'."\n";
                   10203:         }
                   10204:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10205:                    $counter.'" />'."\n";
                   10206:         if ($actionurl eq '/adm/dependencies') { 
                   10207:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10208:                        $numnew.'" />'."\n";
                   10209:         } elsif ($actionurl eq '') {
1.987     raeburn  10210:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10211:         }
                   10212:     } elsif ($applies) {
                   10213:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10214:         if ($applies > 1) {
                   10215:             $output .=  
1.1123    raeburn  10216:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10217:             if ($numremref) {
                   10218:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10219:             }
                   10220:             if ($numinvalid) {
                   10221:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10222:             }
                   10223:             if ($numexisting) {
                   10224:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10225:             }
                   10226:             $output .= '</ul><br />';
                   10227:         } elsif ($numremref) {
                   10228:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10229:         } elsif ($numinvalid) {
                   10230:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10231:         } elsif ($numexisting) {
                   10232:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10233:         }
                   10234:         $output .= $upload_output.'<br />';
                   10235:     }
                   10236:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10237:     $chgcount = $counter;
1.987     raeburn  10238:     if (keys(%pathchanges) > 0) {
                   10239:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10240:             if ($counter) {
1.987     raeburn  10241:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10242:                                                   $embed_file,\%mapping,
1.1071    raeburn  10243:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10244:             } else {
                   10245:                 $pathchange_output .= 
                   10246:                     &start_data_table_row().
                   10247:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10248:                     $chgcount.'" checked="checked" /></td>'.
                   10249:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10250:                     '<td>'.$embed_file.
                   10251:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10252:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10253:                     '</td>'.&end_data_table_row();
1.660     raeburn  10254:             }
1.987     raeburn  10255:             $numpathchg ++;
                   10256:             $chgcount ++;
1.660     raeburn  10257:         }
                   10258:     }
1.1127    raeburn  10259:     if (($counter) || ($numunused)) {
1.987     raeburn  10260:         if ($numpathchg) {
                   10261:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10262:                        $numpathchg.'" />'."\n";
                   10263:         }
                   10264:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10265:             ($actionurl eq '/adm/imsimport')) {
                   10266:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10267:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10268:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10269:         } elsif ($actionurl eq '/adm/dependencies') {
                   10270:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10271:         }
1.1123    raeburn  10272:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10273:     } elsif ($numpathchg) {
                   10274:         my %pathchange = ();
                   10275:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10276:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10277:             $output .= '<p>'.&mt('or').'</p>'; 
1.1123    raeburn  10278:         }
1.987     raeburn  10279:     }
1.1071    raeburn  10280:     return ($output,$counter,$numpathchg);
1.987     raeburn  10281: }
                   10282: 
1.1147    raeburn  10283: =pod
                   10284: 
                   10285: =item * clean_path($name)
                   10286: 
                   10287: Performs clean-up of directories, subdirectories and filename in an
                   10288: embedded object, referenced in an HTML file which is being uploaded
                   10289: to a course or portfolio, where 
                   10290: "Upload embedded images/multimedia files if HTML file" checkbox was
                   10291: checked.
                   10292: 
                   10293: Clean-up is similar to replacements in lonnet::clean_filename()
                   10294: except each / between sub-directory and next level is preserved.
                   10295: 
                   10296: =cut
                   10297: 
                   10298: sub clean_path {
                   10299:     my ($embed_file) = @_;
                   10300:     $embed_file =~s{^/+}{};
                   10301:     my @contents;
                   10302:     if ($embed_file =~ m{/}) {
                   10303:         @contents = split(/\//,$embed_file);
                   10304:     } else {
                   10305:         @contents = ($embed_file);
                   10306:     }
                   10307:     my $lastidx = scalar(@contents)-1;
                   10308:     for (my $i=0; $i<=$lastidx; $i++) { 
                   10309:         $contents[$i]=~s{\\}{/}g;
                   10310:         $contents[$i]=~s/\s+/\_/g;
                   10311:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   10312:         if ($i == $lastidx) {
                   10313:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   10314:         }
                   10315:     }
                   10316:     if ($lastidx > 0) {
                   10317:         return join('/',@contents);
                   10318:     } else {
                   10319:         return $contents[0];
                   10320:     }
                   10321: }
                   10322: 
1.987     raeburn  10323: sub embedded_file_element {
1.1071    raeburn  10324:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10325:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10326:                    (ref($codebase) eq 'HASH'));
                   10327:     my $output;
1.1071    raeburn  10328:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10329:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10330:     }
                   10331:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10332:                &escape($embed_file).'" />';
                   10333:     unless (($context eq 'upload_embedded') && 
                   10334:             ($mapping->{$embed_file} eq $embed_file)) {
                   10335:         $output .='
                   10336:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10337:     }
                   10338:     my $attrib;
                   10339:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10340:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10341:     }
                   10342:     $output .=
                   10343:         "\n\t\t".
                   10344:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10345:         $attrib.'" />';
                   10346:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10347:         $output .=
                   10348:             "\n\t\t".
                   10349:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10350:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10351:     }
1.987     raeburn  10352:     return $output;
1.660     raeburn  10353: }
                   10354: 
1.1071    raeburn  10355: sub get_dependency_details {
                   10356:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10357:     my ($size,$mtime,$showsize,$showmtime);
                   10358:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10359:         if ($embed_file =~ m{/}) {
                   10360:             my ($path,$fname) = split(/\//,$embed_file);
                   10361:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10362:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10363:             }
                   10364:         } else {
                   10365:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10366:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10367:             }
                   10368:         }
                   10369:         $showsize = $size/1024.0;
                   10370:         $showsize = sprintf("%.1f",$showsize);
                   10371:         if ($mtime > 0) {
                   10372:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10373:         }
                   10374:     }
                   10375:     return ($showsize,$showmtime);
                   10376: }
                   10377: 
                   10378: sub ask_embedded_js {
                   10379:     return <<"END";
                   10380: <script type="text/javascript"">
                   10381: // <![CDATA[
                   10382: function toggleBrowse(counter) {
                   10383:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10384:     var fileid = document.getElementById('embedded_item_'+counter);
                   10385:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10386:     if (chkboxid.checked == true) {
                   10387:         uploaddivid.style.display='block';
                   10388:     } else {
                   10389:         uploaddivid.style.display='none';
                   10390:         fileid.value = '';
                   10391:     }
                   10392: }
                   10393: // ]]>
                   10394: </script>
                   10395: 
                   10396: END
                   10397: }
                   10398: 
1.661     raeburn  10399: sub upload_embedded {
                   10400:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10401:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10402:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10403:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10404:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10405:         my $orig_uploaded_filename =
                   10406:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10407:         foreach my $type ('orig','ref','attrib','codebase') {
                   10408:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10409:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10410:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10411:             }
                   10412:         }
1.661     raeburn  10413:         my ($path,$fname) =
                   10414:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10415:         # no path, whole string is fname
                   10416:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10417:         $fname = &Apache::lonnet::clean_filename($fname);
                   10418:         # See if there is anything left
                   10419:         next if ($fname eq '');
                   10420: 
                   10421:         # Check if file already exists as a file or directory.
                   10422:         my ($state,$msg);
                   10423:         if ($context eq 'portfolio') {
                   10424:             my $port_path = $dirpath;
                   10425:             if ($group ne '') {
                   10426:                 $port_path = "groups/$group/$port_path";
                   10427:             }
1.987     raeburn  10428:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10429:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10430:                                               $dir_root,$port_path,$disk_quota,
                   10431:                                               $current_disk_usage,$uname,$udom);
                   10432:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10433:                 || $state eq 'file_locked') {
1.661     raeburn  10434:                 $output .= $msg;
                   10435:                 next;
                   10436:             }
                   10437:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10438:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10439:             if ($state eq 'exists') {
                   10440:                 $output .= $msg;
                   10441:                 next;
                   10442:             }
                   10443:         }
                   10444:         # Check if extension is valid
                   10445:         if (($fname =~ /\.(\w+)$/) &&
                   10446:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155    bisitz   10447:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   10448:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  10449:             next;
                   10450:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10451:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10452:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10453:             next;
                   10454:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120    bisitz   10455:             $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  10456:             next;
                   10457:         }
                   10458:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123    raeburn  10459:         my $subdir = $path;
                   10460:         $subdir =~ s{/+$}{};
1.661     raeburn  10461:         if ($context eq 'portfolio') {
1.984     raeburn  10462:             my $result;
                   10463:             if ($state eq 'existingfile') {
                   10464:                 $result=
                   10465:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123    raeburn  10466:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  10467:             } else {
1.984     raeburn  10468:                 $result=
                   10469:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10470:                                                     $dirpath.
1.1123    raeburn  10471:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  10472:                 if ($result !~ m|^/uploaded/|) {
                   10473:                     $output .= '<span class="LC_error">'
                   10474:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10475:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10476:                                .'</span><br />';
                   10477:                     next;
                   10478:                 } else {
1.987     raeburn  10479:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10480:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10481:                 }
1.661     raeburn  10482:             }
1.1123    raeburn  10483:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126    raeburn  10484:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   10485:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  10486:             my $result =
1.1126    raeburn  10487:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  10488:             if ($result !~ m|^/uploaded/|) {
                   10489:                 $output .= '<span class="LC_error">'
                   10490:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10491:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10492:                            .'</span><br />';
                   10493:                     next;
                   10494:             } else {
                   10495:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10496:                            $path.$fname.'</span>').'<br />';
1.1125    raeburn  10497:                 if ($context eq 'syllabus') {
                   10498:                     &Apache::lonnet::make_public_indefinitely($result);
                   10499:                 }
1.987     raeburn  10500:             }
1.661     raeburn  10501:         } else {
                   10502: # Save the file
                   10503:             my $target = $env{'form.embedded_item_'.$i};
                   10504:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10505:             my $dest = $fullpath.$fname;
                   10506:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10507:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10508:             my $count;
                   10509:             my $filepath = $dir_root;
1.1027    raeburn  10510:             foreach my $subdir (@parts) {
                   10511:                 $filepath .= "/$subdir";
                   10512:                 if (!-e $filepath) {
1.661     raeburn  10513:                     mkdir($filepath,0770);
                   10514:                 }
                   10515:             }
                   10516:             my $fh;
                   10517:             if (!open($fh,'>'.$dest)) {
                   10518:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10519:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10520:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10521:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10522:                            '</span><br />';
                   10523:             } else {
                   10524:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10525:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10526:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10527:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10528:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10529:                               '</span><br />';
                   10530:                 } else {
1.987     raeburn  10531:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10532:                                $url.'</span>').'<br />';
                   10533:                     unless ($context eq 'testbank') {
                   10534:                         $footer .= &mt('View embedded file: [_1]',
                   10535:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10536:                     }
                   10537:                 }
                   10538:                 close($fh);
                   10539:             }
                   10540:         }
                   10541:         if ($env{'form.embedded_ref_'.$i}) {
                   10542:             $pathchange{$i} = 1;
                   10543:         }
                   10544:     }
                   10545:     if ($output) {
                   10546:         $output = '<p>'.$output.'</p>';
                   10547:     }
                   10548:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10549:     $returnflag = 'ok';
1.1071    raeburn  10550:     my $numpathchgs = scalar(keys(%pathchange));
                   10551:     if ($numpathchgs > 0) {
1.987     raeburn  10552:         if ($context eq 'portfolio') {
                   10553:             $output .= '<p>'.&mt('or').'</p>';
                   10554:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10555:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10556:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10557:             $returnflag = 'modify_orightml';
                   10558:         }
                   10559:     }
1.1071    raeburn  10560:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10561: }
                   10562: 
                   10563: sub modify_html_form {
                   10564:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10565:     my $end = 0;
                   10566:     my $modifyform;
                   10567:     if ($context eq 'upload_embedded') {
                   10568:         return unless (ref($pathchange) eq 'HASH');
                   10569:         if ($env{'form.number_embedded_items'}) {
                   10570:             $end += $env{'form.number_embedded_items'};
                   10571:         }
                   10572:         if ($env{'form.number_pathchange_items'}) {
                   10573:             $end += $env{'form.number_pathchange_items'};
                   10574:         }
                   10575:         if ($end) {
                   10576:             for (my $i=0; $i<$end; $i++) {
                   10577:                 if ($i < $env{'form.number_embedded_items'}) {
                   10578:                     next unless($pathchange->{$i});
                   10579:                 }
                   10580:                 $modifyform .=
                   10581:                     &start_data_table_row().
                   10582:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10583:                     'checked="checked" /></td>'.
                   10584:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10585:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10586:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10587:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10588:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10589:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10590:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10591:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10592:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10593:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10594:                     &end_data_table_row();
1.1071    raeburn  10595:             }
1.987     raeburn  10596:         }
                   10597:     } else {
                   10598:         $modifyform = $pathchgtable;
                   10599:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10600:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10601:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10602:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10603:         }
                   10604:     }
                   10605:     if ($modifyform) {
1.1071    raeburn  10606:         if ($actionurl eq '/adm/dependencies') {
                   10607:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10608:         }
1.987     raeburn  10609:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10610:                '<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".
                   10611:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10612:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10613:                '</ol></p>'."\n".'<p>'.
                   10614:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10615:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10616:                &start_data_table()."\n".
                   10617:                &start_data_table_header_row().
                   10618:                '<th>'.&mt('Change?').'</th>'.
                   10619:                '<th>'.&mt('Current reference').'</th>'.
                   10620:                '<th>'.&mt('Required reference').'</th>'.
                   10621:                &end_data_table_header_row()."\n".
                   10622:                $modifyform.
                   10623:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10624:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10625:                '</form>'."\n";
                   10626:     }
                   10627:     return;
                   10628: }
                   10629: 
                   10630: sub modify_html_refs {
1.1123    raeburn  10631:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  10632:     my $container;
                   10633:     if ($context eq 'portfolio') {
                   10634:         $container = $env{'form.container'};
                   10635:     } elsif ($context eq 'coursedoc') {
                   10636:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10637:     } elsif ($context eq 'manage_dependencies') {
                   10638:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10639:         $container = "/$container";
1.1123    raeburn  10640:     } elsif ($context eq 'syllabus') {
                   10641:         $container = $url;
1.987     raeburn  10642:     } else {
1.1027    raeburn  10643:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10644:     }
                   10645:     my (%allfiles,%codebase,$output,$content);
                   10646:     my @changes = &get_env_multiple('form.namechange');
1.1126    raeburn  10647:     unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071    raeburn  10648:         if (wantarray) {
                   10649:             return ('',0,0); 
                   10650:         } else {
                   10651:             return;
                   10652:         }
                   10653:     }
                   10654:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  10655:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  10656:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10657:             if (wantarray) {
                   10658:                 return ('',0,0);
                   10659:             } else {
                   10660:                 return;
                   10661:             }
                   10662:         } 
1.987     raeburn  10663:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10664:         if ($content eq '-1') {
                   10665:             if (wantarray) {
                   10666:                 return ('',0,0);
                   10667:             } else {
                   10668:                 return;
                   10669:             }
                   10670:         }
1.987     raeburn  10671:     } else {
1.1071    raeburn  10672:         unless ($container =~ /^\Q$dir_root\E/) {
                   10673:             if (wantarray) {
                   10674:                 return ('',0,0);
                   10675:             } else {
                   10676:                 return;
                   10677:             }
                   10678:         } 
1.987     raeburn  10679:         if (open(my $fh,"<$container")) {
                   10680:             $content = join('', <$fh>);
                   10681:             close($fh);
                   10682:         } else {
1.1071    raeburn  10683:             if (wantarray) {
                   10684:                 return ('',0,0);
                   10685:             } else {
                   10686:                 return;
                   10687:             }
1.987     raeburn  10688:         }
                   10689:     }
                   10690:     my ($count,$codebasecount) = (0,0);
                   10691:     my $mm = new File::MMagic;
                   10692:     my $mime_type = $mm->checktype_contents($content);
                   10693:     if ($mime_type eq 'text/html') {
                   10694:         my $parse_result = 
                   10695:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10696:                                                     \%codebase,\$content);
                   10697:         if ($parse_result eq 'ok') {
                   10698:             foreach my $i (@changes) {
                   10699:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10700:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10701:                 if ($allfiles{$ref}) {
                   10702:                     my $newname =  $orig;
                   10703:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10704:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10705:                     if ($attrib_regexp =~ /:/) {
                   10706:                         $attrib_regexp =~ s/\:/|/g;
                   10707:                     }
                   10708:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10709:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10710:                         $count += $numchg;
1.1123    raeburn  10711:                         $allfiles{$newname} = $allfiles{$ref};
1.1148    raeburn  10712:                         delete($allfiles{$ref});
1.987     raeburn  10713:                     }
                   10714:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10715:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10716:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10717:                         $codebasecount ++;
                   10718:                     }
                   10719:                 }
                   10720:             }
1.1123    raeburn  10721:             my $skiprewrites;
1.987     raeburn  10722:             if ($count || $codebasecount) {
                   10723:                 my $saveresult;
1.1071    raeburn  10724:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  10725:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  10726:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10727:                     if ($url eq $container) {
                   10728:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10729:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10730:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10731:                                             $fname.'</span>').'</p>';
1.987     raeburn  10732:                     } else {
                   10733:                          $output = '<p class="LC_error">'.
                   10734:                                    &mt('Error: update failed for: [_1].',
                   10735:                                    '<span class="LC_filename">'.
                   10736:                                    $container.'</span>').'</p>';
                   10737:                     }
1.1123    raeburn  10738:                     if ($context eq 'syllabus') {
                   10739:                         unless ($saveresult eq 'ok') {
                   10740:                             $skiprewrites = 1;
                   10741:                         }
                   10742:                     }
1.987     raeburn  10743:                 } else {
                   10744:                     if (open(my $fh,">$container")) {
                   10745:                         print $fh $content;
                   10746:                         close($fh);
                   10747:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10748:                                   $count,'<span class="LC_filename">'.
                   10749:                                   $container.'</span>').'</p>';
1.661     raeburn  10750:                     } else {
1.987     raeburn  10751:                          $output = '<p class="LC_error">'.
                   10752:                                    &mt('Error: could not update [_1].',
                   10753:                                    '<span class="LC_filename">'.
                   10754:                                    $container.'</span>').'</p>';
1.661     raeburn  10755:                     }
                   10756:                 }
                   10757:             }
1.1123    raeburn  10758:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   10759:                 my ($actionurl,$state);
                   10760:                 $actionurl = "/public/$udom/$uname/syllabus";
                   10761:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   10762:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   10763:                                               \%codebase,
                   10764:                                               {'context' => 'rewrites',
                   10765:                                                'ignore_remote_references' => 1,});
                   10766:                 if (ref($mapping) eq 'HASH') {
                   10767:                     my $rewrites = 0;
                   10768:                     foreach my $key (keys(%{$mapping})) {
                   10769:                         next if ($key =~ m{^https?://});
                   10770:                         my $ref = $mapping->{$key};
                   10771:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   10772:                         my $attrib;
                   10773:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   10774:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   10775:                         }
                   10776:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10777:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10778:                             $rewrites += $numchg;
                   10779:                         }
                   10780:                     }
                   10781:                     if ($rewrites) {
                   10782:                         my $saveresult; 
                   10783:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10784:                         if ($url eq $container) {
                   10785:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   10786:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   10787:                                             $count,'<span class="LC_filename">'.
                   10788:                                             $fname.'</span>').'</p>';
                   10789:                         } else {
                   10790:                             $output .= '<p class="LC_error">'.
                   10791:                                        &mt('Error: could not update links in [_1].',
                   10792:                                        '<span class="LC_filename">'.
                   10793:                                        $container.'</span>').'</p>';
                   10794: 
                   10795:                         }
                   10796:                     }
                   10797:                 }
                   10798:             }
1.987     raeburn  10799:         } else {
                   10800:             &logthis('Failed to parse '.$container.
                   10801:                      ' to modify references: '.$parse_result);
1.661     raeburn  10802:         }
                   10803:     }
1.1071    raeburn  10804:     if (wantarray) {
                   10805:         return ($output,$count,$codebasecount);
                   10806:     } else {
                   10807:         return $output;
                   10808:     }
1.661     raeburn  10809: }
                   10810: 
                   10811: sub check_for_existing {
                   10812:     my ($path,$fname,$element) = @_;
                   10813:     my ($state,$msg);
                   10814:     if (-d $path.'/'.$fname) {
                   10815:         $state = 'exists';
                   10816:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10817:     } elsif (-e $path.'/'.$fname) {
                   10818:         $state = 'exists';
                   10819:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10820:     }
                   10821:     if ($state eq 'exists') {
                   10822:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10823:     }
                   10824:     return ($state,$msg);
                   10825: }
                   10826: 
                   10827: sub check_for_upload {
                   10828:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10829:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10830:     my $filesize = length($env{'form.'.$element});
                   10831:     if (!$filesize) {
                   10832:         my $msg = '<span class="LC_error">'.
                   10833:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10834:                       '<span class="LC_filename">'.$fname.'</span>',
                   10835:                       $filesize).'<br />'.
1.1007    raeburn  10836:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10837:                   '</span>';
                   10838:         return ('zero_bytes',$msg);
                   10839:     }
                   10840:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10841:     my $getpropath = 1;
1.1021    raeburn  10842:     my ($dirlistref,$listerror) =
                   10843:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10844:     my $found_file = 0;
                   10845:     my $locked_file = 0;
1.991     raeburn  10846:     my @lockers;
                   10847:     my $navmap;
                   10848:     if ($env{'request.course.id'}) {
                   10849:         $navmap = Apache::lonnavmaps::navmap->new();
                   10850:     }
1.1021    raeburn  10851:     if (ref($dirlistref) eq 'ARRAY') {
                   10852:         foreach my $line (@{$dirlistref}) {
                   10853:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10854:             if ($file_name eq $fname){
                   10855:                 $file_name = $path.$file_name;
                   10856:                 if ($group ne '') {
                   10857:                     $file_name = $group.$file_name;
                   10858:                 }
                   10859:                 $found_file = 1;
                   10860:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10861:                     foreach my $lock (@lockers) {
                   10862:                         if (ref($lock) eq 'ARRAY') {
                   10863:                             my ($symb,$crsid) = @{$lock};
                   10864:                             if ($crsid eq $env{'request.course.id'}) {
                   10865:                                 if (ref($navmap)) {
                   10866:                                     my $res = $navmap->getBySymb($symb);
                   10867:                                     foreach my $part (@{$res->parts()}) { 
                   10868:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10869:                                         unless (($slot_status == $res->RESERVED) ||
                   10870:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10871:                                             $locked_file = 1;
                   10872:                                         }
1.991     raeburn  10873:                                     }
1.1021    raeburn  10874:                                 } else {
                   10875:                                     $locked_file = 1;
1.991     raeburn  10876:                                 }
                   10877:                             } else {
                   10878:                                 $locked_file = 1;
                   10879:                             }
                   10880:                         }
1.1021    raeburn  10881:                    }
                   10882:                 } else {
                   10883:                     my @info = split(/\&/,$rest);
                   10884:                     my $currsize = $info[6]/1000;
                   10885:                     if ($currsize < $filesize) {
                   10886:                         my $extra = $filesize - $currsize;
                   10887:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   10888:                             my $msg = '<span class="LC_error">'.
                   10889:                                       &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.',
                   10890:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   10891:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10892:                                                    $disk_quota,$current_disk_usage);
                   10893:                             return ('will_exceed_quota',$msg);
                   10894:                         }
1.984     raeburn  10895:                     }
                   10896:                 }
1.661     raeburn  10897:             }
                   10898:         }
                   10899:     }
                   10900:     if (($current_disk_usage + $filesize) > $disk_quota){
                   10901:         my $msg = '<span class="LC_error">'.
                   10902:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   10903:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   10904:         return ('will_exceed_quota',$msg);
                   10905:     } elsif ($found_file) {
                   10906:         if ($locked_file) {
                   10907:             my $msg = '<span class="LC_error">';
                   10908:             $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>');
                   10909:             $msg .= '</span><br />';
                   10910:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10911:             return ('file_locked',$msg);
                   10912:         } else {
                   10913:             my $msg = '<span class="LC_error">';
1.984     raeburn  10914:             $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  10915:             $msg .= '</span>';
1.984     raeburn  10916:             return ('existingfile',$msg);
1.661     raeburn  10917:         }
                   10918:     }
                   10919: }
                   10920: 
1.987     raeburn  10921: sub check_for_traversal {
                   10922:     my ($path,$url,$toplevel) = @_;
                   10923:     my @parts=split(/\//,$path);
                   10924:     my $cleanpath;
                   10925:     my $fullpath = $url;
                   10926:     for (my $i=0;$i<@parts;$i++) {
                   10927:         next if ($parts[$i] eq '.');
                   10928:         if ($parts[$i] eq '..') {
                   10929:             $fullpath =~ s{([^/]+/)$}{};
                   10930:         } else {
                   10931:             $fullpath .= $parts[$i].'/';
                   10932:         }
                   10933:     }
                   10934:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10935:         $cleanpath = $1;
                   10936:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10937:         my $curr_toprel = $1;
                   10938:         my @parts = split(/\//,$curr_toprel);
                   10939:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10940:         my @urlparts = split(/\//,$url_toprel);
                   10941:         my $doubledots;
                   10942:         my $startdiff = -1;
                   10943:         for (my $i=0; $i<@urlparts; $i++) {
                   10944:             if ($startdiff == -1) {
                   10945:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10946:                     $startdiff = $i;
                   10947:                     $doubledots .= '../';
                   10948:                 }
                   10949:             } else {
                   10950:                 $doubledots .= '../';
                   10951:             }
                   10952:         }
                   10953:         if ($startdiff > -1) {
                   10954:             $cleanpath = $doubledots;
                   10955:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10956:                 $cleanpath .= $parts[$i].'/';
                   10957:             }
                   10958:         }
                   10959:     }
                   10960:     $cleanpath =~ s{(/)$}{};
                   10961:     return $cleanpath;
                   10962: }
1.31      albertel 10963: 
1.1053    raeburn  10964: sub is_archive_file {
                   10965:     my ($mimetype) = @_;
                   10966:     if (($mimetype eq 'application/octet-stream') ||
                   10967:         ($mimetype eq 'application/x-stuffit') ||
                   10968:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   10969:         return 1;
                   10970:     }
                   10971:     return;
                   10972: }
                   10973: 
                   10974: sub decompress_form {
1.1065    raeburn  10975:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  10976:     my %lt = &Apache::lonlocal::texthash (
                   10977:         this => 'This file is an archive file.',
1.1067    raeburn  10978:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  10979:         itsc => 'Its contents are as follows:',
1.1053    raeburn  10980:         youm => 'You may wish to extract its contents.',
                   10981:         extr => 'Extract contents',
1.1067    raeburn  10982:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   10983:         proa => 'Process automatically?',
1.1053    raeburn  10984:         yes  => 'Yes',
                   10985:         no   => 'No',
1.1067    raeburn  10986:         fold => 'Title for folder containing movie',
                   10987:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  10988:     );
1.1065    raeburn  10989:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  10990:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  10991:     my $info = &list_archive_contents($fileloc,\@paths);
                   10992:     if (@paths) {
                   10993:         foreach my $path (@paths) {
                   10994:             $path =~ s{^/}{};
1.1067    raeburn  10995:             if ($path =~ m{^([^/]+)/$}) {
                   10996:                 $topdir = $1;
                   10997:             }
1.1065    raeburn  10998:             if ($path =~ m{^([^/]+)/}) {
                   10999:                 $toplevel{$1} = $path;
                   11000:             } else {
                   11001:                 $toplevel{$path} = $path;
                   11002:             }
                   11003:         }
                   11004:     }
1.1067    raeburn  11005:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
                   11006:         my @camtasia = ("$topdir/","$topdir/index.html",
                   11007:                         "$topdir/media/",
                   11008:                         "$topdir/media/$topdir.mp4",
                   11009:                         "$topdir/media/FirstFrame.png",
                   11010:                         "$topdir/media/player.swf",
                   11011:                         "$topdir/media/swfobject.js",
                   11012:                         "$topdir/media/expressInstall.swf");
                   11013:         my @diffs = &compare_arrays(\@paths,\@camtasia);
                   11014:         if (@diffs == 0) {
                   11015:             $is_camtasia = 1;
                   11016:         }
                   11017:     }
                   11018:     my $output;
                   11019:     if ($is_camtasia) {
                   11020:         $output = <<"ENDCAM";
                   11021: <script type="text/javascript" language="Javascript">
                   11022: // <![CDATA[
                   11023: 
                   11024: function camtasiaToggle() {
                   11025:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11026:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
                   11027:             if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
                   11028: 
                   11029:                 document.getElementById('camtasia_titles').style.display='block';
                   11030:             } else {
                   11031:                 document.getElementById('camtasia_titles').style.display='none';
                   11032:             }
                   11033:         }
                   11034:     }
                   11035:     return;
                   11036: }
                   11037: 
                   11038: // ]]>
                   11039: </script>
                   11040: <p>$lt{'camt'}</p>
                   11041: ENDCAM
1.1065    raeburn  11042:     } else {
1.1067    raeburn  11043:         $output = '<p>'.$lt{'this'};
                   11044:         if ($info eq '') {
                   11045:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11046:         } else {
                   11047:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11048:                        '<div><pre>'.$info.'</pre></div>';
                   11049:         }
1.1065    raeburn  11050:     }
1.1067    raeburn  11051:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11052:     my $duplicates;
                   11053:     my $num = 0;
                   11054:     if (ref($dirlist) eq 'ARRAY') {
                   11055:         foreach my $item (@{$dirlist}) {
                   11056:             if (ref($item) eq 'ARRAY') {
                   11057:                 if (exists($toplevel{$item->[0]})) {
                   11058:                     $duplicates .= 
                   11059:                         &start_data_table_row().
                   11060:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11061:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11062:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11063:                         'value="1" />'.&mt('Yes').'</label>'.
                   11064:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11065:                         '<td>'.$item->[0].'</td>';
                   11066:                     if ($item->[2]) {
                   11067:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11068:                     } else {
                   11069:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11070:                     }
                   11071:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11072:                                    '<td>'.
                   11073:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11074:                                    '</td>'.
                   11075:                                    &end_data_table_row();
                   11076:                     $num ++;
                   11077:                 }
                   11078:             }
                   11079:         }
                   11080:     }
                   11081:     my $itemcount;
                   11082:     if (@paths > 0) {
                   11083:         $itemcount = scalar(@paths);
                   11084:     } else {
                   11085:         $itemcount = 1;
                   11086:     }
1.1067    raeburn  11087:     if ($is_camtasia) {
                   11088:         $output .= $lt{'auto'}.'<br />'.
                   11089:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                   11090:                    '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                   11091:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11092:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11093:                    $lt{'no'}.'</label></span><br />'.
                   11094:                    '<div id="camtasia_titles" style="display:block">'.
                   11095:                    &Apache::lonhtmlcommon::start_pick_box().
                   11096:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11097:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11098:                    &Apache::lonhtmlcommon::row_closure().
                   11099:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11100:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11101:                    &Apache::lonhtmlcommon::row_closure(1).
                   11102:                    &Apache::lonhtmlcommon::end_pick_box().
                   11103:                    '</div>';
                   11104:     }
1.1065    raeburn  11105:     $output .= 
                   11106:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11107:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11108:         "\n";
1.1065    raeburn  11109:     if ($duplicates ne '') {
                   11110:         $output .= '<p><span class="LC_warning">'.
                   11111:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11112:                    &start_data_table().
                   11113:                    &start_data_table_header_row().
                   11114:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11115:                    '<th>'.&mt('Name').'</th>'.
                   11116:                    '<th>'.&mt('Type').'</th>'.
                   11117:                    '<th>'.&mt('Size').'</th>'.
                   11118:                    '<th>'.&mt('Last modified').'</th>'.
                   11119:                    &end_data_table_header_row().
                   11120:                    $duplicates.
                   11121:                    &end_data_table().
                   11122:                    '</p>';
                   11123:     }
1.1067    raeburn  11124:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11125:     if (ref($hiddenelements) eq 'HASH') {
                   11126:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11127:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11128:         }
                   11129:     }
                   11130:     $output .= <<"END";
1.1067    raeburn  11131: <br />
1.1053    raeburn  11132: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11133: </form>
                   11134: $noextract
                   11135: END
                   11136:     return $output;
                   11137: }
                   11138: 
1.1065    raeburn  11139: sub decompression_utility {
                   11140:     my ($program) = @_;
                   11141:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11142:     my $location;
                   11143:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11144:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11145:                          '/usr/sbin/') {
                   11146:             if (-x $dir.$program) {
                   11147:                 $location = $dir.$program;
                   11148:                 last;
                   11149:             }
                   11150:         }
                   11151:     }
                   11152:     return $location;
                   11153: }
                   11154: 
                   11155: sub list_archive_contents {
                   11156:     my ($file,$pathsref) = @_;
                   11157:     my (@cmd,$output);
                   11158:     my $needsregexp;
                   11159:     if ($file =~ /\.zip$/) {
                   11160:         @cmd = (&decompression_utility('unzip'),"-l");
                   11161:         $needsregexp = 1;
                   11162:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11163:              ($file =~ /\.tgz$/)) {
                   11164:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11165:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11166:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11167:     } elsif ($file =~ m|\.tar$|) {
                   11168:         @cmd = (&decompression_utility('tar'),"-tf");
                   11169:     }
                   11170:     if (@cmd) {
                   11171:         undef($!);
                   11172:         undef($@);
                   11173:         if (open(my $fh,"-|", @cmd, $file)) {
                   11174:             while (my $line = <$fh>) {
                   11175:                 $output .= $line;
                   11176:                 chomp($line);
                   11177:                 my $item;
                   11178:                 if ($needsregexp) {
                   11179:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11180:                 } else {
                   11181:                     $item = $line;
                   11182:                 }
                   11183:                 if ($item ne '') {
                   11184:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11185:                         push(@{$pathsref},$item);
                   11186:                     } 
                   11187:                 }
                   11188:             }
                   11189:             close($fh);
                   11190:         }
                   11191:     }
                   11192:     return $output;
                   11193: }
                   11194: 
1.1053    raeburn  11195: sub decompress_uploaded_file {
                   11196:     my ($file,$dir) = @_;
                   11197:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11198:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11199:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11200:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11201:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11202:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11203:     my $decompressed = $env{'cgi.decompressed'};
                   11204:     &Apache::lonnet::delenv('cgi.file');
                   11205:     &Apache::lonnet::delenv('cgi.dir');
                   11206:     &Apache::lonnet::delenv('cgi.decompressed');
                   11207:     return ($decompressed,$result);
                   11208: }
                   11209: 
1.1055    raeburn  11210: sub process_decompression {
                   11211:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11212:     my ($dir,$error,$warning,$output);
                   11213:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
1.1120    bisitz   11214:         $error = &mt('Filename not a supported archive file type.').
                   11215:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11216:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11217:     } else {
                   11218:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11219:         if ($docuhome eq 'no_host') {
                   11220:             $error = &mt('Could not determine home server for course.');
                   11221:         } else {
                   11222:             my @ids=&Apache::lonnet::current_machine_ids();
                   11223:             my $currdir = "$dir_root/$destination";
                   11224:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11225:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11226:                        "$dir_root/$destination";
                   11227:             } else {
                   11228:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11229:                        "$dir_root/$docudom/$docuname/$destination";
                   11230:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11231:                     $error = &mt('Archive file not found.');
                   11232:                 }
                   11233:             }
1.1065    raeburn  11234:             my (@to_overwrite,@to_skip);
                   11235:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11236:                 my $total = $env{'form.archive_overwrite_total'};
                   11237:                 for (my $i=0; $i<$total; $i++) {
                   11238:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11239:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11240:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11241:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11242:                     }
                   11243:                 }
                   11244:             }
                   11245:             my $numskip = scalar(@to_skip);
                   11246:             if (($numskip > 0) && 
                   11247:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11248:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11249:             } elsif ($dir eq '') {
1.1055    raeburn  11250:                 $error = &mt('Directory containing archive file unavailable.');
                   11251:             } elsif (!$error) {
1.1065    raeburn  11252:                 my ($decompressed,$display);
                   11253:                 if ($numskip > 0) {
                   11254:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11255:                     mkdir("$dir/$tempdir",0755);
                   11256:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11257:                     ($decompressed,$display) = 
                   11258:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11259:                     foreach my $item (@to_skip) {
                   11260:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11261:                             if (-f "$dir/$tempdir/$item") { 
                   11262:                                 unlink("$dir/$tempdir/$item");
                   11263:                             } elsif (-d "$dir/$tempdir/$item") {
                   11264:                                 system("rm -rf $dir/$tempdir/$item");
                   11265:                             }
                   11266:                         }
                   11267:                     }
                   11268:                     system("mv $dir/$tempdir/* $dir");
                   11269:                     rmdir("$dir/$tempdir");   
                   11270:                 } else {
                   11271:                     ($decompressed,$display) = 
                   11272:                         &decompress_uploaded_file($file,$dir);
                   11273:                 }
1.1055    raeburn  11274:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11275:                     $output = '<p class="LC_info">'.
                   11276:                               &mt('Files extracted successfully from archive.').
                   11277:                               '</p>'."\n";
1.1055    raeburn  11278:                     my ($warning,$result,@contents);
                   11279:                     my ($newdirlistref,$newlisterror) =
                   11280:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11281:                                                  $docuname,1);
                   11282:                     my (%is_dir,%changes,@newitems);
                   11283:                     my $dirptr = 16384;
1.1065    raeburn  11284:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11285:                         foreach my $dir_line (@{$newdirlistref}) {
                   11286:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11287:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11288:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11289:                                 push(@newitems,$item);
                   11290:                                 if ($dirptr&$testdir) {
                   11291:                                     $is_dir{$item} = 1;
                   11292:                                 }
                   11293:                                 $changes{$item} = 1;
                   11294:                             }
                   11295:                         }
                   11296:                     }
                   11297:                     if (keys(%changes) > 0) {
                   11298:                         foreach my $item (sort(@newitems)) {
                   11299:                             if ($changes{$item}) {
                   11300:                                 push(@contents,$item);
                   11301:                             }
                   11302:                         }
                   11303:                     }
                   11304:                     if (@contents > 0) {
1.1067    raeburn  11305:                         my $wantform;
                   11306:                         unless ($env{'form.autoextract_camtasia'}) {
                   11307:                             $wantform = 1;
                   11308:                         }
1.1056    raeburn  11309:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11310:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11311:                                                                 $currdir,\%is_dir,
                   11312:                                                                 \%children,\%parent,
1.1056    raeburn  11313:                                                                 \@contents,\%dirorder,
                   11314:                                                                 \%titles,$wantform);
1.1055    raeburn  11315:                         if ($datatable ne '') {
                   11316:                             $output .= &archive_options_form('decompressed',$datatable,
                   11317:                                                              $count,$hiddenelem);
1.1065    raeburn  11318:                             my $startcount = 6;
1.1055    raeburn  11319:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11320:                                                            \%titles,\%children);
1.1055    raeburn  11321:                         }
1.1067    raeburn  11322:                         if ($env{'form.autoextract_camtasia'}) {
                   11323:                             my %displayed;
                   11324:                             my $total = 1;
                   11325:                             $env{'form.archive_directory'} = [];
                   11326:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11327:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11328:                                 $path =~ s{/$}{};
                   11329:                                 my $item;
                   11330:                                 if ($path ne '') {
                   11331:                                     $item = "$path/$titles{$i}";
                   11332:                                 } else {
                   11333:                                     $item = $titles{$i};
                   11334:                                 }
                   11335:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11336:                                 if ($item eq $contents[0]) {
                   11337:                                     push(@{$env{'form.archive_directory'}},$i);
                   11338:                                     $env{'form.archive_'.$i} = 'display';
                   11339:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11340:                                     $displayed{'folder'} = $i;
                   11341:                                 } elsif ($item eq "$contents[0]/index.html") {
                   11342:                                     $env{'form.archive_'.$i} = 'display';
                   11343:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11344:                                     $displayed{'web'} = $i;
                   11345:                                 } else {
                   11346:                                     if ($item eq "$contents[0]/media") {
                   11347:                                         push(@{$env{'form.archive_directory'}},$i);
                   11348:                                     }
                   11349:                                     $env{'form.archive_'.$i} = 'dependency';
                   11350:                                 }
                   11351:                                 $total ++;
                   11352:                             }
                   11353:                             for (my $i=1; $i<$total; $i++) {
                   11354:                                 next if ($i == $displayed{'web'});
                   11355:                                 next if ($i == $displayed{'folder'});
                   11356:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11357:                             }
                   11358:                             $env{'form.phase'} = 'decompress_cleanup';
                   11359:                             $env{'form.archivedelete'} = 1;
                   11360:                             $env{'form.archive_count'} = $total-1;
                   11361:                             $output .=
                   11362:                                 &process_extracted_files('coursedocs',$docudom,
                   11363:                                                          $docuname,$destination,
                   11364:                                                          $dir_root,$hiddenelem);
                   11365:                         }
1.1055    raeburn  11366:                     } else {
                   11367:                         $warning = &mt('No new items extracted from archive file.');
                   11368:                     }
                   11369:                 } else {
                   11370:                     $output = $display;
                   11371:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11372:                 }
                   11373:             }
                   11374:         }
                   11375:     }
                   11376:     if ($error) {
                   11377:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11378:                    $error.'</p>'."\n";
                   11379:     }
                   11380:     if ($warning) {
                   11381:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11382:     }
                   11383:     return $output;
                   11384: }
                   11385: 
                   11386: sub get_extracted {
1.1056    raeburn  11387:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11388:         $titles,$wantform) = @_;
1.1055    raeburn  11389:     my $count = 0;
                   11390:     my $depth = 0;
                   11391:     my $datatable;
1.1056    raeburn  11392:     my @hierarchy;
1.1055    raeburn  11393:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11394:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11395:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11396:     foreach my $item (@{$contents}) {
                   11397:         $count ++;
1.1056    raeburn  11398:         @{$dirorder->{$count}} = @hierarchy;
                   11399:         $titles->{$count} = $item;
1.1055    raeburn  11400:         &archive_hierarchy($depth,$count,$parent,$children);
                   11401:         if ($wantform) {
                   11402:             $datatable .= &archive_row($is_dir->{$item},$item,
                   11403:                                        $currdir,$depth,$count);
                   11404:         }
                   11405:         if ($is_dir->{$item}) {
                   11406:             $depth ++;
1.1056    raeburn  11407:             push(@hierarchy,$count);
                   11408:             $parent->{$depth} = $count;
1.1055    raeburn  11409:             $datatable .=
                   11410:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  11411:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   11412:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  11413:             $depth --;
1.1056    raeburn  11414:             pop(@hierarchy);
1.1055    raeburn  11415:         }
                   11416:     }
                   11417:     return ($count,$datatable);
                   11418: }
                   11419: 
                   11420: sub recurse_extracted_archive {
1.1056    raeburn  11421:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   11422:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  11423:     my $result='';
1.1056    raeburn  11424:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   11425:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   11426:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  11427:         return $result;
                   11428:     }
                   11429:     my $dirptr = 16384;
                   11430:     my ($newdirlistref,$newlisterror) =
                   11431:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   11432:     if (ref($newdirlistref) eq 'ARRAY') {
                   11433:         foreach my $dir_line (@{$newdirlistref}) {
                   11434:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   11435:             unless ($item =~ /^\.+$/) {
                   11436:                 $$count ++;
1.1056    raeburn  11437:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   11438:                 $titles->{$$count} = $item;
1.1055    raeburn  11439:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  11440: 
1.1055    raeburn  11441:                 my $is_dir;
                   11442:                 if ($dirptr&$testdir) {
                   11443:                     $is_dir = 1;
                   11444:                 }
                   11445:                 if ($wantform) {
                   11446:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11447:                 }
                   11448:                 if ($is_dir) {
                   11449:                     $$depth ++;
1.1056    raeburn  11450:                     push(@{$hierarchy},$$count);
                   11451:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11452:                     $result .=
                   11453:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11454:                                                    $docuname,$depth,$count,
1.1056    raeburn  11455:                                                    $hierarchy,$dirorder,$children,
                   11456:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11457:                     $$depth --;
1.1056    raeburn  11458:                     pop(@{$hierarchy});
1.1055    raeburn  11459:                 }
                   11460:             }
                   11461:         }
                   11462:     }
                   11463:     return $result;
                   11464: }
                   11465: 
                   11466: sub archive_hierarchy {
                   11467:     my ($depth,$count,$parent,$children) =@_;
                   11468:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11469:         if (exists($parent->{$depth})) {
                   11470:              $children->{$parent->{$depth}} .= $count.':';
                   11471:         }
                   11472:     }
                   11473:     return;
                   11474: }
                   11475: 
                   11476: sub archive_row {
                   11477:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11478:     my ($name) = ($item =~ m{([^/]+)$});
                   11479:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11480:                                        'display'    => 'Add as file',
1.1055    raeburn  11481:                                        'dependency' => 'Include as dependency',
                   11482:                                        'discard'    => 'Discard',
                   11483:                                       );
                   11484:     if ($is_dir) {
1.1059    raeburn  11485:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11486:     }
1.1056    raeburn  11487:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11488:     my $offset = 0;
1.1055    raeburn  11489:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11490:         $offset ++;
1.1065    raeburn  11491:         if ($action ne 'display') {
                   11492:             $offset ++;
                   11493:         }  
1.1055    raeburn  11494:         $output .= '<td><span class="LC_nobreak">'.
                   11495:                    '<label><input type="radio" name="archive_'.$count.
                   11496:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11497:         my $text = $choices{$action};
                   11498:         if ($is_dir) {
                   11499:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11500:             if ($action eq 'display') {
1.1059    raeburn  11501:                 $text = &mt('Add as folder');
1.1055    raeburn  11502:             }
1.1056    raeburn  11503:         } else {
                   11504:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11505: 
                   11506:         }
                   11507:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11508:         if ($action eq 'dependency') {
                   11509:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11510:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11511:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11512:                        '<option value=""></option>'."\n".
                   11513:                        '</select>'."\n".
                   11514:                        '</div>';
1.1059    raeburn  11515:         } elsif ($action eq 'display') {
                   11516:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11517:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11518:                        '</div>';
1.1055    raeburn  11519:         }
1.1056    raeburn  11520:         $output .= '</td>';
1.1055    raeburn  11521:     }
                   11522:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11523:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11524:     for (my $i=0; $i<$depth; $i++) {
                   11525:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11526:     }
                   11527:     if ($is_dir) {
                   11528:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11529:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11530:     } else {
                   11531:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11532:     }
                   11533:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11534:                &end_data_table_row();
                   11535:     return $output;
                   11536: }
                   11537: 
                   11538: sub archive_options_form {
1.1065    raeburn  11539:     my ($form,$display,$count,$hiddenelem) = @_;
                   11540:     my %lt = &Apache::lonlocal::texthash(
                   11541:                perm => 'Permanently remove archive file?',
                   11542:                hows => 'How should each extracted item be incorporated in the course?',
                   11543:                cont => 'Content actions for all',
                   11544:                addf => 'Add as folder/file',
                   11545:                incd => 'Include as dependency for a displayed file',
                   11546:                disc => 'Discard',
                   11547:                no   => 'No',
                   11548:                yes  => 'Yes',
                   11549:                save => 'Save',
                   11550:     );
                   11551:     my $output = <<"END";
                   11552: <form name="$form" method="post" action="">
                   11553: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11554: <label>
                   11555:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11556: </label>
                   11557: &nbsp;
                   11558: <label>
                   11559:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11560: </span>
                   11561: </p>
                   11562: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11563: <br />$lt{'hows'}
                   11564: <div class="LC_columnSection">
                   11565:   <fieldset>
                   11566:     <legend>$lt{'cont'}</legend>
                   11567:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11568:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11569:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11570:   </fieldset>
                   11571: </div>
                   11572: END
                   11573:     return $output.
1.1055    raeburn  11574:            &start_data_table()."\n".
1.1065    raeburn  11575:            $display."\n".
1.1055    raeburn  11576:            &end_data_table()."\n".
                   11577:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11578:            $hiddenelem.
1.1065    raeburn  11579:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11580:            '</form>';
                   11581: }
                   11582: 
                   11583: sub archive_javascript {
1.1056    raeburn  11584:     my ($startcount,$numitems,$titles,$children) = @_;
                   11585:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11586:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11587:     my $scripttag = <<START;
                   11588: <script type="text/javascript">
                   11589: // <![CDATA[
                   11590: 
                   11591: function checkAll(form,prefix) {
                   11592:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11593:     for (var i=0; i < form.elements.length; i++) {
                   11594:         var id = form.elements[i].id;
                   11595:         if ((id != '') && (id != undefined)) {
                   11596:             if (idstr.test(id)) {
                   11597:                 if (form.elements[i].type == 'radio') {
                   11598:                     form.elements[i].checked = true;
1.1056    raeburn  11599:                     var nostart = i-$startcount;
1.1059    raeburn  11600:                     var offset = nostart%7;
                   11601:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11602:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11603:                 }
                   11604:             }
                   11605:         }
                   11606:     }
                   11607: }
                   11608: 
                   11609: function propagateCheck(form,count) {
                   11610:     if (count > 0) {
1.1059    raeburn  11611:         var startelement = $startcount + ((count-1) * 7);
                   11612:         for (var j=1; j<6; j++) {
                   11613:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11614:                 var item = startelement + j; 
                   11615:                 if (form.elements[item].type == 'radio') {
                   11616:                     if (form.elements[item].checked) {
                   11617:                         containerCheck(form,count,j);
                   11618:                         break;
                   11619:                     }
1.1055    raeburn  11620:                 }
                   11621:             }
                   11622:         }
                   11623:     }
                   11624: }
                   11625: 
                   11626: numitems = $numitems
1.1056    raeburn  11627: var titles = new Array(numitems);
                   11628: var parents = new Array(numitems);
1.1055    raeburn  11629: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11630:     parents[i] = new Array;
1.1055    raeburn  11631: }
1.1059    raeburn  11632: var maintitle = '$maintitle';
1.1055    raeburn  11633: 
                   11634: START
                   11635: 
1.1056    raeburn  11636:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11637:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11638:         for (my $i=0; $i<@contents; $i ++) {
                   11639:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11640:         }
                   11641:     }
                   11642: 
1.1056    raeburn  11643:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11644:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11645:     }
                   11646: 
1.1055    raeburn  11647:     $scripttag .= <<END;
                   11648: 
                   11649: function containerCheck(form,count,offset) {
                   11650:     if (count > 0) {
1.1056    raeburn  11651:         dependencyCheck(form,count,offset);
1.1059    raeburn  11652:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11653:         form.elements[item].checked = true;
                   11654:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11655:             if (parents[count].length > 0) {
                   11656:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11657:                     containerCheck(form,parents[count][j],offset);
                   11658:                 }
                   11659:             }
                   11660:         }
                   11661:     }
                   11662: }
                   11663: 
                   11664: function dependencyCheck(form,count,offset) {
                   11665:     if (count > 0) {
1.1059    raeburn  11666:         var chosen = (offset+$startcount)+7*(count-1);
                   11667:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11668:         var currtype = form.elements[depitem].type;
                   11669:         if (form.elements[chosen].value == 'dependency') {
                   11670:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11671:             form.elements[depitem].options.length = 0;
                   11672:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  11673:             for (var i=1; i<=numitems; i++) {
                   11674:                 if (i == count) {
                   11675:                     continue;
                   11676:                 }
1.1059    raeburn  11677:                 var startelement = $startcount + (i-1) * 7;
                   11678:                 for (var j=1; j<6; j++) {
                   11679:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11680:                         var item = startelement + j;
                   11681:                         if (form.elements[item].type == 'radio') {
                   11682:                             if (form.elements[item].checked) {
                   11683:                                 if (form.elements[item].value == 'display') {
                   11684:                                     var n = form.elements[depitem].options.length;
                   11685:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11686:                                 }
                   11687:                             }
                   11688:                         }
                   11689:                     }
                   11690:                 }
                   11691:             }
                   11692:         } else {
                   11693:             document.getElementById('arc_depon_'+count).style.display='none';
                   11694:             form.elements[depitem].options.length = 0;
                   11695:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11696:         }
1.1059    raeburn  11697:         titleCheck(form,count,offset);
1.1056    raeburn  11698:     }
                   11699: }
                   11700: 
                   11701: function propagateSelect(form,count,offset) {
                   11702:     if (count > 0) {
1.1065    raeburn  11703:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11704:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11705:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11706:             if (parents[count].length > 0) {
                   11707:                 for (var j=0; j<parents[count].length; j++) {
                   11708:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11709:                 }
                   11710:             }
                   11711:         }
                   11712:     }
                   11713: }
1.1056    raeburn  11714: 
                   11715: function containerSelect(form,count,offset,picked) {
                   11716:     if (count > 0) {
1.1065    raeburn  11717:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11718:         if (form.elements[item].type == 'radio') {
                   11719:             if (form.elements[item].value == 'dependency') {
                   11720:                 if (form.elements[item+1].type == 'select-one') {
                   11721:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11722:                         if (form.elements[item+1].options[i].value == picked) {
                   11723:                             form.elements[item+1].selectedIndex = i;
                   11724:                             break;
                   11725:                         }
                   11726:                     }
                   11727:                 }
                   11728:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11729:                     if (parents[count].length > 0) {
                   11730:                         for (var j=0; j<parents[count].length; j++) {
                   11731:                             containerSelect(form,parents[count][j],offset,picked);
                   11732:                         }
                   11733:                     }
                   11734:                 }
                   11735:             }
                   11736:         }
                   11737:     }
                   11738: }
                   11739: 
1.1059    raeburn  11740: function titleCheck(form,count,offset) {
                   11741:     if (count > 0) {
                   11742:         var chosen = (offset+$startcount)+7*(count-1);
                   11743:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11744:         var currtype = form.elements[depitem].type;
                   11745:         if (form.elements[chosen].value == 'display') {
                   11746:             document.getElementById('arc_title_'+count).style.display='block';
                   11747:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11748:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11749:             }
                   11750:         } else {
                   11751:             document.getElementById('arc_title_'+count).style.display='none';
                   11752:             if (currtype == 'text') { 
                   11753:                 document.getElementById('archive_title_'+count).value='';
                   11754:             }
                   11755:         }
                   11756:     }
                   11757:     return;
                   11758: }
                   11759: 
1.1055    raeburn  11760: // ]]>
                   11761: </script>
                   11762: END
                   11763:     return $scripttag;
                   11764: }
                   11765: 
                   11766: sub process_extracted_files {
1.1067    raeburn  11767:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11768:     my $numitems = $env{'form.archive_count'};
                   11769:     return unless ($numitems);
                   11770:     my @ids=&Apache::lonnet::current_machine_ids();
                   11771:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11772:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11773:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11774:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11775:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11776:         $pathtocheck = "$dir_root/$destination";
                   11777:         $dir = $dir_root;
                   11778:         $ishome = 1;
                   11779:     } else {
                   11780:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11781:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11782:         $dir = "$dir_root/$docudom/$docuname";    
                   11783:     }
                   11784:     my $currdir = "$dir_root/$destination";
                   11785:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11786:     if ($env{'form.folderpath'}) {
                   11787:         my @items = split('&',$env{'form.folderpath'});
                   11788:         $folders{'0'} = $items[-2];
1.1099    raeburn  11789:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11790:             $containers{'0'}='page';
                   11791:         } else {  
                   11792:             $containers{'0'}='sequence';
                   11793:         }
1.1055    raeburn  11794:     }
                   11795:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11796:     if ($numitems) {
                   11797:         for (my $i=1; $i<=$numitems; $i++) {
                   11798:             my $path = $env{'form.archive_content_'.$i};
                   11799:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11800:                 my $item = $1;
                   11801:                 $toplevelitems{$item} = $i;
                   11802:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11803:                     $is_dir{$item} = 1;
                   11804:                 }
                   11805:             }
                   11806:         }
                   11807:     }
1.1067    raeburn  11808:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11809:     if (keys(%toplevelitems) > 0) {
                   11810:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11811:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11812:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11813:     }
1.1066    raeburn  11814:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11815:     if ($numitems) {
                   11816:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  11817:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11818:             my $path = $env{'form.archive_content_'.$i};
                   11819:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11820:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11821:                     if ($prefix ne '' && $path ne '') {
                   11822:                         if (-e $prefix.$path) {
1.1066    raeburn  11823:                             if ((@archdirs > 0) && 
                   11824:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11825:                                 $todeletedir{$prefix.$path} = 1;
                   11826:                             } else {
                   11827:                                 $todelete{$prefix.$path} = 1;
                   11828:                             }
1.1055    raeburn  11829:                         }
                   11830:                     }
                   11831:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11832:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11833:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11834:                     $docstitle = $env{'form.archive_title_'.$i};
                   11835:                     if ($docstitle eq '') {
                   11836:                         $docstitle = $title;
                   11837:                     }
1.1055    raeburn  11838:                     $outer = 0;
1.1056    raeburn  11839:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11840:                         if (@{$dirorder{$i}} > 0) {
                   11841:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11842:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11843:                                     $outer = $item;
                   11844:                                     last;
                   11845:                                 }
                   11846:                             }
                   11847:                         }
                   11848:                     }
                   11849:                     my ($errtext,$fatal) = 
                   11850:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11851:                                                '/'.$folders{$outer}.'.'.
                   11852:                                                $containers{$outer});
                   11853:                     next if ($fatal);
                   11854:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11855:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11856:                             $mapinner{$i} = time;
1.1055    raeburn  11857:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11858:                             $containers{$i} = 'sequence';
                   11859:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11860:                                       $folders{$i}.'.'.$containers{$i};
                   11861:                             my $newidx = &LONCAPA::map::getresidx();
                   11862:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11863:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11864:                             push(@LONCAPA::map::order,$newidx);
                   11865:                             my ($outtext,$errtext) =
                   11866:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11867:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  11868:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11869:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11870:                             unless ($errtext) {
                   11871:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11872:                             }
1.1055    raeburn  11873:                         }
                   11874:                     } else {
                   11875:                         if ($context eq 'coursedocs') {
                   11876:                             my $newidx=&LONCAPA::map::getresidx();
                   11877:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11878:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11879:                                       $title;
                   11880:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11881:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11882:                             }
                   11883:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11884:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11885:                             }
                   11886:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11887:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11888:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11889:                                 unless ($ishome) {
                   11890:                                     my $fetch = "$newdest{$i}/$title";
                   11891:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11892:                                     $prompttofetch{$fetch} = 1;
                   11893:                                 }
1.1055    raeburn  11894:                             }
                   11895:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11896:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11897:                             push(@LONCAPA::map::order, $newidx);
                   11898:                             my ($outtext,$errtext)=
                   11899:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11900:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  11901:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11902:                             unless ($errtext) {
                   11903:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11904:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11905:                                 }
                   11906:                             }
1.1055    raeburn  11907:                         }
                   11908:                     }
1.1086    raeburn  11909:                 }
                   11910:             } else {
                   11911:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   11912:             }
                   11913:         }
                   11914:         for (my $i=1; $i<=$numitems; $i++) {
                   11915:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11916:             my $path = $env{'form.archive_content_'.$i};
                   11917:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11918:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11919:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11920:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11921:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11922:                         my ($itemidx,$fullpath,$relpath);
                   11923:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11924:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11925:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  11926:                                 if ($dirorder{$i}->[$j] eq $container) {
                   11927:                                     $itemidx = $j;
1.1056    raeburn  11928:                                 }
                   11929:                             }
1.1086    raeburn  11930:                         }
                   11931:                         if ($itemidx eq '') {
                   11932:                             $itemidx =  0;
                   11933:                         } 
                   11934:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   11935:                             if ($mapinner{$referrer{$i}}) {
                   11936:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   11937:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11938:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11939:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11940:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11941:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11942:                                             if (!-e $fullpath) {
                   11943:                                                 mkdir($fullpath,0755);
1.1056    raeburn  11944:                                             }
                   11945:                                         }
1.1086    raeburn  11946:                                     } else {
                   11947:                                         last;
1.1056    raeburn  11948:                                     }
1.1086    raeburn  11949:                                 }
                   11950:                             }
                   11951:                         } elsif ($newdest{$referrer{$i}}) {
                   11952:                             $fullpath = $newdest{$referrer{$i}};
                   11953:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11954:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   11955:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   11956:                                     last;
                   11957:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11958:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11959:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11960:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11961:                                         if (!-e $fullpath) {
                   11962:                                             mkdir($fullpath,0755);
1.1056    raeburn  11963:                                         }
                   11964:                                     }
1.1086    raeburn  11965:                                 } else {
                   11966:                                     last;
1.1056    raeburn  11967:                                 }
1.1055    raeburn  11968:                             }
                   11969:                         }
1.1086    raeburn  11970:                         if ($fullpath ne '') {
                   11971:                             if (-e "$prefix$path") {
                   11972:                                 system("mv $prefix$path $fullpath/$title");
                   11973:                             }
                   11974:                             if (-e "$fullpath/$title") {
                   11975:                                 my $showpath;
                   11976:                                 if ($relpath ne '') {
                   11977:                                     $showpath = "$relpath/$title";
                   11978:                                 } else {
                   11979:                                     $showpath = "/$title";
                   11980:                                 } 
                   11981:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   11982:                             } 
                   11983:                             unless ($ishome) {
                   11984:                                 my $fetch = "$fullpath/$title";
                   11985:                                 $fetch =~ s/^\Q$prefix$dir\E//; 
                   11986:                                 $prompttofetch{$fetch} = 1;
                   11987:                             }
                   11988:                         }
1.1055    raeburn  11989:                     }
1.1086    raeburn  11990:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   11991:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   11992:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  11993:                 }
                   11994:             } else {
                   11995:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   11996:             }
                   11997:         }
                   11998:         if (keys(%todelete)) {
                   11999:             foreach my $key (keys(%todelete)) {
                   12000:                 unlink($key);
1.1066    raeburn  12001:             }
                   12002:         }
                   12003:         if (keys(%todeletedir)) {
                   12004:             foreach my $key (keys(%todeletedir)) {
                   12005:                 rmdir($key);
                   12006:             }
                   12007:         }
                   12008:         foreach my $dir (sort(keys(%is_dir))) {
                   12009:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12010:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12011:             }
                   12012:         }
1.1067    raeburn  12013:         if ($result ne '') {
                   12014:             $output .= '<ul>'."\n".
                   12015:                        $result."\n".
                   12016:                        '</ul>';
                   12017:         }
                   12018:         unless ($ishome) {
                   12019:             my $replicationfail;
                   12020:             foreach my $item (keys(%prompttofetch)) {
                   12021:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12022:                 unless ($fetchresult eq 'ok') {
                   12023:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12024:                 }
                   12025:             }
                   12026:             if ($replicationfail) {
                   12027:                 $output .= '<p class="LC_error">'.
                   12028:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12029:                            $replicationfail.
                   12030:                            '</ul></p>';
                   12031:             }
                   12032:         }
1.1055    raeburn  12033:     } else {
                   12034:         $warning = &mt('No items found in archive.');
                   12035:     }
                   12036:     if ($error) {
                   12037:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12038:                    $error.'</p>'."\n";
                   12039:     }
                   12040:     if ($warning) {
                   12041:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12042:     }
                   12043:     return $output;
                   12044: }
                   12045: 
1.1066    raeburn  12046: sub cleanup_empty_dirs {
                   12047:     my ($path) = @_;
                   12048:     if (($path ne '') && (-d $path)) {
                   12049:         if (opendir(my $dirh,$path)) {
                   12050:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12051:             my $numitems = 0;
                   12052:             foreach my $item (@dircontents) {
                   12053:                 if (-d "$path/$item") {
1.1111    raeburn  12054:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12055:                     if (-e "$path/$item") {
                   12056:                         $numitems ++;
                   12057:                     }
                   12058:                 } else {
                   12059:                     $numitems ++;
                   12060:                 }
                   12061:             }
                   12062:             if ($numitems == 0) {
                   12063:                 rmdir($path);
                   12064:             }
                   12065:             closedir($dirh);
                   12066:         }
                   12067:     }
                   12068:     return;
                   12069: }
                   12070: 
1.41      ng       12071: =pod
1.45      matthew  12072: 
1.1068    raeburn  12073: =item &get_folder_hierarchy()
                   12074: 
                   12075: Provides hierarchy of names of folders/sub-folders containing the current
                   12076: item,
                   12077: 
                   12078: Inputs: 3
                   12079:      - $navmap - navmaps object
                   12080: 
                   12081:      - $map - url for map (either the trigger itself, or map containing
                   12082:                            the resource, which is the trigger).
                   12083: 
                   12084:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12085: 
                   12086: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12087: 
                   12088: =cut
                   12089: 
                   12090: sub get_folder_hierarchy {
                   12091:     my ($navmap,$map,$showitem) = @_;
                   12092:     my @pathitems;
                   12093:     if (ref($navmap)) {
                   12094:         my $mapres = $navmap->getResourceByUrl($map);
                   12095:         if (ref($mapres)) {
                   12096:             my $pcslist = $mapres->map_hierarchy();
                   12097:             if ($pcslist ne '') {
                   12098:                 my @pcs = split(/,/,$pcslist);
                   12099:                 foreach my $pc (@pcs) {
                   12100:                     if ($pc == 1) {
1.1129    raeburn  12101:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12102:                     } else {
                   12103:                         my $res = $navmap->getByMapPc($pc);
                   12104:                         if (ref($res)) {
                   12105:                             my $title = $res->compTitle();
                   12106:                             $title =~ s/\W+/_/g;
                   12107:                             if ($title ne '') {
                   12108:                                 push(@pathitems,$title);
                   12109:                             }
                   12110:                         }
                   12111:                     }
                   12112:                 }
                   12113:             }
1.1071    raeburn  12114:             if ($showitem) {
                   12115:                 if ($mapres->{ID} eq '0.0') {
1.1129    raeburn  12116:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12117:                 } else {
                   12118:                     my $maptitle = $mapres->compTitle();
                   12119:                     $maptitle =~ s/\W+/_/g;
                   12120:                     if ($maptitle ne '') {
                   12121:                         push(@pathitems,$maptitle);
                   12122:                     }
1.1068    raeburn  12123:                 }
                   12124:             }
                   12125:         }
                   12126:     }
                   12127:     return @pathitems;
                   12128: }
                   12129: 
                   12130: =pod
                   12131: 
1.1015    raeburn  12132: =item * &get_turnedin_filepath()
                   12133: 
                   12134: Determines path in a user's portfolio file for storage of files uploaded
                   12135: to a specific essayresponse or dropbox item.
                   12136: 
                   12137: Inputs: 3 required + 1 optional.
                   12138: $symb is symb for resource, $uname and $udom are for current user (required).
                   12139: $caller is optional (can be "submission", if routine is called when storing
                   12140: an upoaded file when "Submit Answer" button was pressed).
                   12141: 
                   12142: Returns array containing $path and $multiresp. 
                   12143: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12144: than one file upload item.  Callers of routine should append partid as a 
                   12145: subdirectory to $path in cases where $multiresp is 1.
                   12146: 
                   12147: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12148: 
                   12149: =cut
                   12150: 
                   12151: sub get_turnedin_filepath {
                   12152:     my ($symb,$uname,$udom,$caller) = @_;
                   12153:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12154:     my $turnindir;
                   12155:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12156:     $turnindir = $userhash{'turnindir'};
                   12157:     my ($path,$multiresp);
                   12158:     if ($turnindir eq '') {
                   12159:         if ($caller eq 'submission') {
                   12160:             $turnindir = &mt('turned in');
                   12161:             $turnindir =~ s/\W+/_/g;
                   12162:             my %newhash = (
                   12163:                             'turnindir' => $turnindir,
                   12164:                           );
                   12165:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12166:         }
                   12167:     }
                   12168:     if ($turnindir ne '') {
                   12169:         $path = '/'.$turnindir.'/';
                   12170:         my ($multipart,$turnin,@pathitems);
                   12171:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12172:         if (defined($navmap)) {
                   12173:             my $mapres = $navmap->getResourceByUrl($map);
                   12174:             if (ref($mapres)) {
                   12175:                 my $pcslist = $mapres->map_hierarchy();
                   12176:                 if ($pcslist ne '') {
                   12177:                     foreach my $pc (split(/,/,$pcslist)) {
                   12178:                         my $res = $navmap->getByMapPc($pc);
                   12179:                         if (ref($res)) {
                   12180:                             my $title = $res->compTitle();
                   12181:                             $title =~ s/\W+/_/g;
                   12182:                             if ($title ne '') {
1.1149    raeburn  12183:                                 if (($pc > 1) && (length($title) > 12)) {
                   12184:                                     $title = substr($title,0,12);
                   12185:                                 }
1.1015    raeburn  12186:                                 push(@pathitems,$title);
                   12187:                             }
                   12188:                         }
                   12189:                     }
                   12190:                 }
                   12191:                 my $maptitle = $mapres->compTitle();
                   12192:                 $maptitle =~ s/\W+/_/g;
                   12193:                 if ($maptitle ne '') {
1.1149    raeburn  12194:                     if (length($maptitle) > 12) {
                   12195:                         $maptitle = substr($maptitle,0,12);
                   12196:                     }
1.1015    raeburn  12197:                     push(@pathitems,$maptitle);
                   12198:                 }
                   12199:                 unless ($env{'request.state'} eq 'construct') {
                   12200:                     my $res = $navmap->getBySymb($symb);
                   12201:                     if (ref($res)) {
                   12202:                         my $partlist = $res->parts();
                   12203:                         my $totaluploads = 0;
                   12204:                         if (ref($partlist) eq 'ARRAY') {
                   12205:                             foreach my $part (@{$partlist}) {
                   12206:                                 my @types = $res->responseType($part);
                   12207:                                 my @ids = $res->responseIds($part);
                   12208:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12209:                                     if ($types[$i] eq 'essay') {
                   12210:                                         my $partid = $part.'_'.$ids[$i];
                   12211:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12212:                                             $totaluploads ++;
                   12213:                                         }
                   12214:                                     }
                   12215:                                 }
                   12216:                             }
                   12217:                             if ($totaluploads > 1) {
                   12218:                                 $multiresp = 1;
                   12219:                             }
                   12220:                         }
                   12221:                     }
                   12222:                 }
                   12223:             } else {
                   12224:                 return;
                   12225:             }
                   12226:         } else {
                   12227:             return;
                   12228:         }
                   12229:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12230:         $restitle =~ s/\W+/_/g;
                   12231:         if ($restitle eq '') {
                   12232:             $restitle = ($resurl =~ m{/[^/]+$});
                   12233:             if ($restitle eq '') {
                   12234:                 $restitle = time;
                   12235:             }
                   12236:         }
1.1149    raeburn  12237:         if (length($restitle) > 12) {
                   12238:             $restitle = substr($restitle,0,12);
                   12239:         }
1.1015    raeburn  12240:         push(@pathitems,$restitle);
                   12241:         $path .= join('/',@pathitems);
                   12242:     }
                   12243:     return ($path,$multiresp);
                   12244: }
                   12245: 
                   12246: =pod
                   12247: 
1.464     albertel 12248: =back
1.41      ng       12249: 
1.112     bowersj2 12250: =head1 CSV Upload/Handling functions
1.38      albertel 12251: 
1.41      ng       12252: =over 4
                   12253: 
1.648     raeburn  12254: =item * &upfile_store($r)
1.41      ng       12255: 
                   12256: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12257: needs $env{'form.upfile'}
1.41      ng       12258: returns $datatoken to be put into hidden field
                   12259: 
                   12260: =cut
1.31      albertel 12261: 
                   12262: sub upfile_store {
                   12263:     my $r=shift;
1.258     albertel 12264:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12265:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12266:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12267:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12268: 
1.258     albertel 12269:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12270: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12271:     {
1.158     raeburn  12272:         my $datafile = $r->dir_config('lonDaemons').
                   12273:                            '/tmp/'.$datatoken.'.tmp';
                   12274:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12275:             print $fh $env{'form.upfile'};
1.158     raeburn  12276:             close($fh);
                   12277:         }
1.31      albertel 12278:     }
                   12279:     return $datatoken;
                   12280: }
                   12281: 
1.56      matthew  12282: =pod
                   12283: 
1.648     raeburn  12284: =item * &load_tmp_file($r)
1.41      ng       12285: 
                   12286: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12287: needs $env{'form.datatoken'},
                   12288: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12289: 
                   12290: =cut
1.31      albertel 12291: 
                   12292: sub load_tmp_file {
                   12293:     my $r=shift;
                   12294:     my @studentdata=();
                   12295:     {
1.158     raeburn  12296:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12297:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12298:         if ( open(my $fh,"<$studentfile") ) {
                   12299:             @studentdata=<$fh>;
                   12300:             close($fh);
                   12301:         }
1.31      albertel 12302:     }
1.258     albertel 12303:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12304: }
                   12305: 
1.56      matthew  12306: =pod
                   12307: 
1.648     raeburn  12308: =item * &upfile_record_sep()
1.41      ng       12309: 
                   12310: Separate uploaded file into records
                   12311: returns array of records,
1.258     albertel 12312: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12313: 
                   12314: =cut
1.31      albertel 12315: 
                   12316: sub upfile_record_sep {
1.258     albertel 12317:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12318:     } else {
1.248     albertel 12319: 	my @records;
1.258     albertel 12320: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12321: 	    if ($line=~/^\s*$/) { next; }
                   12322: 	    push(@records,$line);
                   12323: 	}
                   12324: 	return @records;
1.31      albertel 12325:     }
                   12326: }
                   12327: 
1.56      matthew  12328: =pod
                   12329: 
1.648     raeburn  12330: =item * &record_sep($record)
1.41      ng       12331: 
1.258     albertel 12332: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12333: 
                   12334: =cut
                   12335: 
1.263     www      12336: sub takeleft {
                   12337:     my $index=shift;
                   12338:     return substr('0000'.$index,-4,4);
                   12339: }
                   12340: 
1.31      albertel 12341: sub record_sep {
                   12342:     my $record=shift;
                   12343:     my %components=();
1.258     albertel 12344:     if ($env{'form.upfiletype'} eq 'xml') {
                   12345:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12346:         my $i=0;
1.356     albertel 12347:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12348:             $field=~s/^(\"|\')//;
                   12349:             $field=~s/(\"|\')$//;
1.263     www      12350:             $components{&takeleft($i)}=$field;
1.31      albertel 12351:             $i++;
                   12352:         }
1.258     albertel 12353:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12354:         my $i=0;
1.356     albertel 12355:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12356:             $field=~s/^(\"|\')//;
                   12357:             $field=~s/(\"|\')$//;
1.263     www      12358:             $components{&takeleft($i)}=$field;
1.31      albertel 12359:             $i++;
                   12360:         }
                   12361:     } else {
1.561     www      12362:         my $separator=',';
1.480     banghart 12363:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12364:             $separator=';';
1.480     banghart 12365:         }
1.31      albertel 12366:         my $i=0;
1.561     www      12367: # the character we are looking for to indicate the end of a quote or a record 
                   12368:         my $looking_for=$separator;
                   12369: # do not add the characters to the fields
                   12370:         my $ignore=0;
                   12371: # we just encountered a separator (or the beginning of the record)
                   12372:         my $just_found_separator=1;
                   12373: # store the field we are working on here
                   12374:         my $field='';
                   12375: # work our way through all characters in record
                   12376:         foreach my $character ($record=~/(.)/g) {
                   12377:             if ($character eq $looking_for) {
                   12378:                if ($character ne $separator) {
                   12379: # Found the end of a quote, again looking for separator
                   12380:                   $looking_for=$separator;
                   12381:                   $ignore=1;
                   12382:                } else {
                   12383: # Found a separator, store away what we got
                   12384:                   $components{&takeleft($i)}=$field;
                   12385: 	          $i++;
                   12386:                   $just_found_separator=1;
                   12387:                   $ignore=0;
                   12388:                   $field='';
                   12389:                }
                   12390:                next;
                   12391:             }
                   12392: # single or double quotation marks after a separator indicate beginning of a quote
                   12393: # we are now looking for the end of the quote and need to ignore separators
                   12394:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12395:                $looking_for=$character;
                   12396:                next;
                   12397:             }
                   12398: # ignore would be true after we reached the end of a quote
                   12399:             if ($ignore) { next; }
                   12400:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   12401:             $field.=$character;
                   12402:             $just_found_separator=0; 
1.31      albertel 12403:         }
1.561     www      12404: # catch the very last entry, since we never encountered the separator
                   12405:         $components{&takeleft($i)}=$field;
1.31      albertel 12406:     }
                   12407:     return %components;
                   12408: }
                   12409: 
1.144     matthew  12410: ######################################################
                   12411: ######################################################
                   12412: 
1.56      matthew  12413: =pod
                   12414: 
1.648     raeburn  12415: =item * &upfile_select_html()
1.41      ng       12416: 
1.144     matthew  12417: Return HTML code to select a file from the users machine and specify 
                   12418: the file type.
1.41      ng       12419: 
                   12420: =cut
                   12421: 
1.144     matthew  12422: ######################################################
                   12423: ######################################################
1.31      albertel 12424: sub upfile_select_html {
1.144     matthew  12425:     my %Types = (
                   12426:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 12427:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  12428:                  space => &mt('Space separated'),
                   12429:                  tab   => &mt('Tabulator separated'),
                   12430: #                 xml   => &mt('HTML/XML'),
                   12431:                  );
                   12432:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  12433:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  12434:     foreach my $type (sort(keys(%Types))) {
                   12435:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   12436:     }
                   12437:     $Str .= "</select>\n";
                   12438:     return $Str;
1.31      albertel 12439: }
                   12440: 
1.301     albertel 12441: sub get_samples {
                   12442:     my ($records,$toget) = @_;
                   12443:     my @samples=({});
                   12444:     my $got=0;
                   12445:     foreach my $rec (@$records) {
                   12446: 	my %temp = &record_sep($rec);
                   12447: 	if (! grep(/\S/, values(%temp))) { next; }
                   12448: 	if (%temp) {
                   12449: 	    $samples[$got]=\%temp;
                   12450: 	    $got++;
                   12451: 	    if ($got == $toget) { last; }
                   12452: 	}
                   12453:     }
                   12454:     return \@samples;
                   12455: }
                   12456: 
1.144     matthew  12457: ######################################################
                   12458: ######################################################
                   12459: 
1.56      matthew  12460: =pod
                   12461: 
1.648     raeburn  12462: =item * &csv_print_samples($r,$records)
1.41      ng       12463: 
                   12464: Prints a table of sample values from each column uploaded $r is an
                   12465: Apache Request ref, $records is an arrayref from
                   12466: &Apache::loncommon::upfile_record_sep
                   12467: 
                   12468: =cut
                   12469: 
1.144     matthew  12470: ######################################################
                   12471: ######################################################
1.31      albertel 12472: sub csv_print_samples {
                   12473:     my ($r,$records) = @_;
1.662     bisitz   12474:     my $samples = &get_samples($records,5);
1.301     albertel 12475: 
1.594     raeburn  12476:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12477:               &start_data_table_header_row());
1.356     albertel 12478:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12479:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12480:     $r->print(&end_data_table_header_row());
1.301     albertel 12481:     foreach my $hash (@$samples) {
1.594     raeburn  12482: 	$r->print(&start_data_table_row());
1.356     albertel 12483: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12484: 	    $r->print('<td>');
1.356     albertel 12485: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12486: 	    $r->print('</td>');
                   12487: 	}
1.594     raeburn  12488: 	$r->print(&end_data_table_row());
1.31      albertel 12489:     }
1.594     raeburn  12490:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12491: }
                   12492: 
1.144     matthew  12493: ######################################################
                   12494: ######################################################
                   12495: 
1.56      matthew  12496: =pod
                   12497: 
1.648     raeburn  12498: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12499: 
                   12500: Prints a table to create associations between values and table columns.
1.144     matthew  12501: 
1.41      ng       12502: $r is an Apache Request ref,
                   12503: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12504: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12505: 
                   12506: =cut
                   12507: 
1.144     matthew  12508: ######################################################
                   12509: ######################################################
1.31      albertel 12510: sub csv_print_select_table {
                   12511:     my ($r,$records,$d) = @_;
1.301     albertel 12512:     my $i=0;
                   12513:     my $samples = &get_samples($records,1);
1.144     matthew  12514:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12515: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12516:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12517:               '<th>'.&mt('Column').'</th>'.
                   12518:               &end_data_table_header_row()."\n");
1.356     albertel 12519:     foreach my $array_ref (@$d) {
                   12520: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12521: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12522: 
1.875     bisitz   12523: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12524: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12525: 	$r->print('<option value="none"></option>');
1.356     albertel 12526: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12527: 	    $r->print('<option value="'.$sample.'"'.
                   12528:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12529:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12530: 	}
1.594     raeburn  12531: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12532: 	$i++;
                   12533:     }
1.594     raeburn  12534:     $r->print(&end_data_table());
1.31      albertel 12535:     $i--;
                   12536:     return $i;
                   12537: }
1.56      matthew  12538: 
1.144     matthew  12539: ######################################################
                   12540: ######################################################
                   12541: 
1.56      matthew  12542: =pod
1.31      albertel 12543: 
1.648     raeburn  12544: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12545: 
                   12546: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12547: 
                   12548: $r is an Apache Request ref,
                   12549: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12550: $d is an array of 2 element arrays (internal name, displayed name)
                   12551: 
                   12552: =cut
                   12553: 
1.144     matthew  12554: ######################################################
                   12555: ######################################################
1.31      albertel 12556: sub csv_samples_select_table {
                   12557:     my ($r,$records,$d) = @_;
                   12558:     my $i=0;
1.144     matthew  12559:     #
1.662     bisitz   12560:     my $max_samples = 5;
                   12561:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12562:     $r->print(&start_data_table().
                   12563:               &start_data_table_header_row().'<th>'.
                   12564:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12565:               &end_data_table_header_row());
1.301     albertel 12566: 
                   12567:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12568: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12569: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12570: 	foreach my $option (@$d) {
                   12571: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12572: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12573:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12574:                       $display.'</option>');
1.31      albertel 12575: 	}
                   12576: 	$r->print('</select></td><td>');
1.662     bisitz   12577: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12578: 	    if (defined($samples->[$line]{$key})) { 
                   12579: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12580: 	    }
                   12581: 	}
1.594     raeburn  12582: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12583: 	$i++;
                   12584:     }
1.594     raeburn  12585:     $r->print(&end_data_table());
1.31      albertel 12586:     $i--;
                   12587:     return($i);
1.115     matthew  12588: }
                   12589: 
1.144     matthew  12590: ######################################################
                   12591: ######################################################
                   12592: 
1.115     matthew  12593: =pod
                   12594: 
1.648     raeburn  12595: =item * &clean_excel_name($name)
1.115     matthew  12596: 
                   12597: Returns a replacement for $name which does not contain any illegal characters.
                   12598: 
                   12599: =cut
                   12600: 
1.144     matthew  12601: ######################################################
                   12602: ######################################################
1.115     matthew  12603: sub clean_excel_name {
                   12604:     my ($name) = @_;
                   12605:     $name =~ s/[:\*\?\/\\]//g;
                   12606:     if (length($name) > 31) {
                   12607:         $name = substr($name,0,31);
                   12608:     }
                   12609:     return $name;
1.25      albertel 12610: }
1.84      albertel 12611: 
1.85      albertel 12612: =pod
                   12613: 
1.648     raeburn  12614: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12615: 
                   12616: Returns either 1 or undef
                   12617: 
                   12618: 1 if the part is to be hidden, undef if it is to be shown
                   12619: 
                   12620: Arguments are:
                   12621: 
                   12622: $id the id of the part to be checked
                   12623: $symb, optional the symb of the resource to check
                   12624: $udom, optional the domain of the user to check for
                   12625: $uname, optional the username of the user to check for
                   12626: 
                   12627: =cut
1.84      albertel 12628: 
                   12629: sub check_if_partid_hidden {
                   12630:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12631:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12632: 					 $symb,$udom,$uname);
1.141     albertel 12633:     my $truth=1;
                   12634:     #if the string starts with !, then the list is the list to show not hide
                   12635:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12636:     my @hiddenlist=split(/,/,$hiddenparts);
                   12637:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12638: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12639:     }
1.141     albertel 12640:     return !$truth;
1.84      albertel 12641: }
1.127     matthew  12642: 
1.138     matthew  12643: 
                   12644: ############################################################
                   12645: ############################################################
                   12646: 
                   12647: =pod
                   12648: 
1.157     matthew  12649: =back 
                   12650: 
1.138     matthew  12651: =head1 cgi-bin script and graphing routines
                   12652: 
1.157     matthew  12653: =over 4
                   12654: 
1.648     raeburn  12655: =item * &get_cgi_id()
1.138     matthew  12656: 
                   12657: Inputs: none
                   12658: 
                   12659: Returns an id which can be used to pass environment variables
                   12660: to various cgi-bin scripts.  These environment variables will
                   12661: be removed from the users environment after a given time by
                   12662: the routine &Apache::lonnet::transfer_profile_to_env.
                   12663: 
                   12664: =cut
                   12665: 
                   12666: ############################################################
                   12667: ############################################################
1.152     albertel 12668: my $uniq=0;
1.136     matthew  12669: sub get_cgi_id {
1.154     albertel 12670:     $uniq=($uniq+1)%100000;
1.280     albertel 12671:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12672: }
                   12673: 
1.127     matthew  12674: ############################################################
                   12675: ############################################################
                   12676: 
                   12677: =pod
                   12678: 
1.648     raeburn  12679: =item * &DrawBarGraph()
1.127     matthew  12680: 
1.138     matthew  12681: Facilitates the plotting of data in a (stacked) bar graph.
                   12682: Puts plot definition data into the users environment in order for 
                   12683: graph.png to plot it.  Returns an <img> tag for the plot.
                   12684: The bars on the plot are labeled '1','2',...,'n'.
                   12685: 
                   12686: Inputs:
                   12687: 
                   12688: =over 4
                   12689: 
                   12690: =item $Title: string, the title of the plot
                   12691: 
                   12692: =item $xlabel: string, text describing the X-axis of the plot
                   12693: 
                   12694: =item $ylabel: string, text describing the Y-axis of the plot
                   12695: 
                   12696: =item $Max: scalar, the maximum Y value to use in the plot
                   12697: If $Max is < any data point, the graph will not be rendered.
                   12698: 
1.140     matthew  12699: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12700: they are plotted.  If undefined, default values will be used.
                   12701: 
1.178     matthew  12702: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12703: 
1.138     matthew  12704: =item @Values: An array of array references.  Each array reference holds data
                   12705: to be plotted in a stacked bar chart.
                   12706: 
1.239     matthew  12707: =item If the final element of @Values is a hash reference the key/value
                   12708: pairs will be added to the graph definition.
                   12709: 
1.138     matthew  12710: =back
                   12711: 
                   12712: Returns:
                   12713: 
                   12714: An <img> tag which references graph.png and the appropriate identifying
                   12715: information for the plot.
                   12716: 
1.127     matthew  12717: =cut
                   12718: 
                   12719: ############################################################
                   12720: ############################################################
1.134     matthew  12721: sub DrawBarGraph {
1.178     matthew  12722:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12723:     #
                   12724:     if (! defined($colors)) {
                   12725:         $colors = ['#33ff00', 
                   12726:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12727:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12728:                   ]; 
                   12729:     }
1.228     matthew  12730:     my $extra_settings = {};
                   12731:     if (ref($Values[-1]) eq 'HASH') {
                   12732:         $extra_settings = pop(@Values);
                   12733:     }
1.127     matthew  12734:     #
1.136     matthew  12735:     my $identifier = &get_cgi_id();
                   12736:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12737:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12738:         return '';
                   12739:     }
1.225     matthew  12740:     #
                   12741:     my @Labels;
                   12742:     if (defined($labels)) {
                   12743:         @Labels = @$labels;
                   12744:     } else {
                   12745:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12746:             push (@Labels,$i+1);
                   12747:         }
                   12748:     }
                   12749:     #
1.129     matthew  12750:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12751:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12752:     my %ValuesHash;
                   12753:     my $NumSets=1;
                   12754:     foreach my $array (@Values) {
                   12755:         next if (! ref($array));
1.136     matthew  12756:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12757:             join(',',@$array);
1.129     matthew  12758:     }
1.127     matthew  12759:     #
1.136     matthew  12760:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12761:     if ($NumBars < 3) {
                   12762:         $width = 120+$NumBars*32;
1.220     matthew  12763:         $xskip = 1;
1.225     matthew  12764:         $bar_width = 30;
                   12765:     } elsif ($NumBars < 5) {
                   12766:         $width = 120+$NumBars*20;
                   12767:         $xskip = 1;
                   12768:         $bar_width = 20;
1.220     matthew  12769:     } elsif ($NumBars < 10) {
1.136     matthew  12770:         $width = 120+$NumBars*15;
                   12771:         $xskip = 1;
                   12772:         $bar_width = 15;
                   12773:     } elsif ($NumBars <= 25) {
                   12774:         $width = 120+$NumBars*11;
                   12775:         $xskip = 5;
                   12776:         $bar_width = 8;
                   12777:     } elsif ($NumBars <= 50) {
                   12778:         $width = 120+$NumBars*8;
                   12779:         $xskip = 5;
                   12780:         $bar_width = 4;
                   12781:     } else {
                   12782:         $width = 120+$NumBars*8;
                   12783:         $xskip = 5;
                   12784:         $bar_width = 4;
                   12785:     }
                   12786:     #
1.137     matthew  12787:     $Max = 1 if ($Max < 1);
                   12788:     if ( int($Max) < $Max ) {
                   12789:         $Max++;
                   12790:         $Max = int($Max);
                   12791:     }
1.127     matthew  12792:     $Title  = '' if (! defined($Title));
                   12793:     $xlabel = '' if (! defined($xlabel));
                   12794:     $ylabel = '' if (! defined($ylabel));
1.369     www      12795:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12796:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12797:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12798:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12799:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12800:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12801:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12802:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12803:     $ValuesHash{$id.'.height'}   = $height;
                   12804:     $ValuesHash{$id.'.width'}    = $width;
                   12805:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12806:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12807:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12808:     #
1.228     matthew  12809:     # Deal with other parameters
                   12810:     while (my ($key,$value) = each(%$extra_settings)) {
                   12811:         $ValuesHash{$id.'.'.$key} = $value;
                   12812:     }
                   12813:     #
1.646     raeburn  12814:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12815:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12816: }
                   12817: 
                   12818: ############################################################
                   12819: ############################################################
                   12820: 
                   12821: =pod
                   12822: 
1.648     raeburn  12823: =item * &DrawXYGraph()
1.137     matthew  12824: 
1.138     matthew  12825: Facilitates the plotting of data in an XY graph.
                   12826: Puts plot definition data into the users environment in order for 
                   12827: graph.png to plot it.  Returns an <img> tag for the plot.
                   12828: 
                   12829: Inputs:
                   12830: 
                   12831: =over 4
                   12832: 
                   12833: =item $Title: string, the title of the plot
                   12834: 
                   12835: =item $xlabel: string, text describing the X-axis of the plot
                   12836: 
                   12837: =item $ylabel: string, text describing the Y-axis of the plot
                   12838: 
                   12839: =item $Max: scalar, the maximum Y value to use in the plot
                   12840: If $Max is < any data point, the graph will not be rendered.
                   12841: 
                   12842: =item $colors: Array ref containing the hex color codes for the data to be 
                   12843: plotted in.  If undefined, default values will be used.
                   12844: 
                   12845: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12846: 
                   12847: =item $Ydata: Array ref containing Array refs.  
1.185     www      12848: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12849: 
                   12850: =item %Values: hash indicating or overriding any default values which are 
                   12851: passed to graph.png.  
                   12852: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12853: 
                   12854: =back
                   12855: 
                   12856: Returns:
                   12857: 
                   12858: An <img> tag which references graph.png and the appropriate identifying
                   12859: information for the plot.
                   12860: 
1.137     matthew  12861: =cut
                   12862: 
                   12863: ############################################################
                   12864: ############################################################
                   12865: sub DrawXYGraph {
                   12866:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12867:     #
                   12868:     # Create the identifier for the graph
                   12869:     my $identifier = &get_cgi_id();
                   12870:     my $id = 'cgi.'.$identifier;
                   12871:     #
                   12872:     $Title  = '' if (! defined($Title));
                   12873:     $xlabel = '' if (! defined($xlabel));
                   12874:     $ylabel = '' if (! defined($ylabel));
                   12875:     my %ValuesHash = 
                   12876:         (
1.369     www      12877:          $id.'.title'  => &escape($Title),
                   12878:          $id.'.xlabel' => &escape($xlabel),
                   12879:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12880:          $id.'.y_max_value'=> $Max,
                   12881:          $id.'.labels'     => join(',',@$Xlabels),
                   12882:          $id.'.PlotType'   => 'XY',
                   12883:          );
                   12884:     #
                   12885:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12886:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12887:     }
                   12888:     #
                   12889:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12890:         return '';
                   12891:     }
                   12892:     my $NumSets=1;
1.138     matthew  12893:     foreach my $array (@{$Ydata}){
1.137     matthew  12894:         next if (! ref($array));
                   12895:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12896:     }
1.138     matthew  12897:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12898:     #
                   12899:     # Deal with other parameters
                   12900:     while (my ($key,$value) = each(%Values)) {
                   12901:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12902:     }
                   12903:     #
1.646     raeburn  12904:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12905:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12906: }
                   12907: 
                   12908: ############################################################
                   12909: ############################################################
                   12910: 
                   12911: =pod
                   12912: 
1.648     raeburn  12913: =item * &DrawXYYGraph()
1.138     matthew  12914: 
                   12915: Facilitates the plotting of data in an XY graph with two Y axes.
                   12916: Puts plot definition data into the users environment in order for 
                   12917: graph.png to plot it.  Returns an <img> tag for the plot.
                   12918: 
                   12919: Inputs:
                   12920: 
                   12921: =over 4
                   12922: 
                   12923: =item $Title: string, the title of the plot
                   12924: 
                   12925: =item $xlabel: string, text describing the X-axis of the plot
                   12926: 
                   12927: =item $ylabel: string, text describing the Y-axis of the plot
                   12928: 
                   12929: =item $colors: Array ref containing the hex color codes for the data to be 
                   12930: plotted in.  If undefined, default values will be used.
                   12931: 
                   12932: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12933: 
                   12934: =item $Ydata1: The first data set
                   12935: 
                   12936: =item $Min1: The minimum value of the left Y-axis
                   12937: 
                   12938: =item $Max1: The maximum value of the left Y-axis
                   12939: 
                   12940: =item $Ydata2: The second data set
                   12941: 
                   12942: =item $Min2: The minimum value of the right Y-axis
                   12943: 
                   12944: =item $Max2: The maximum value of the left Y-axis
                   12945: 
                   12946: =item %Values: hash indicating or overriding any default values which are 
                   12947: passed to graph.png.  
                   12948: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12949: 
                   12950: =back
                   12951: 
                   12952: Returns:
                   12953: 
                   12954: An <img> tag which references graph.png and the appropriate identifying
                   12955: information for the plot.
1.136     matthew  12956: 
                   12957: =cut
                   12958: 
                   12959: ############################################################
                   12960: ############################################################
1.137     matthew  12961: sub DrawXYYGraph {
                   12962:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   12963:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  12964:     #
                   12965:     # Create the identifier for the graph
                   12966:     my $identifier = &get_cgi_id();
                   12967:     my $id = 'cgi.'.$identifier;
                   12968:     #
                   12969:     $Title  = '' if (! defined($Title));
                   12970:     $xlabel = '' if (! defined($xlabel));
                   12971:     $ylabel = '' if (! defined($ylabel));
                   12972:     my %ValuesHash = 
                   12973:         (
1.369     www      12974:          $id.'.title'  => &escape($Title),
                   12975:          $id.'.xlabel' => &escape($xlabel),
                   12976:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  12977:          $id.'.labels' => join(',',@$Xlabels),
                   12978:          $id.'.PlotType' => 'XY',
                   12979:          $id.'.NumSets' => 2,
1.137     matthew  12980:          $id.'.two_axes' => 1,
                   12981:          $id.'.y1_max_value' => $Max1,
                   12982:          $id.'.y1_min_value' => $Min1,
                   12983:          $id.'.y2_max_value' => $Max2,
                   12984:          $id.'.y2_min_value' => $Min2,
1.136     matthew  12985:          );
                   12986:     #
1.137     matthew  12987:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12988:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12989:     }
                   12990:     #
                   12991:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   12992:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  12993:         return '';
                   12994:     }
                   12995:     my $NumSets=1;
1.137     matthew  12996:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  12997:         next if (! ref($array));
                   12998:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  12999:     }
                   13000:     #
                   13001:     # Deal with other parameters
                   13002:     while (my ($key,$value) = each(%Values)) {
                   13003:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13004:     }
                   13005:     #
1.646     raeburn  13006:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13007:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13008: }
                   13009: 
                   13010: ############################################################
                   13011: ############################################################
                   13012: 
                   13013: =pod
                   13014: 
1.157     matthew  13015: =back 
                   13016: 
1.139     matthew  13017: =head1 Statistics helper routines?  
                   13018: 
                   13019: Bad place for them but what the hell.
                   13020: 
1.157     matthew  13021: =over 4
                   13022: 
1.648     raeburn  13023: =item * &chartlink()
1.139     matthew  13024: 
                   13025: Returns a link to the chart for a specific student.  
                   13026: 
                   13027: Inputs:
                   13028: 
                   13029: =over 4
                   13030: 
                   13031: =item $linktext: The text of the link
                   13032: 
                   13033: =item $sname: The students username
                   13034: 
                   13035: =item $sdomain: The students domain
                   13036: 
                   13037: =back
                   13038: 
1.157     matthew  13039: =back
                   13040: 
1.139     matthew  13041: =cut
                   13042: 
                   13043: ############################################################
                   13044: ############################################################
                   13045: sub chartlink {
                   13046:     my ($linktext, $sname, $sdomain) = @_;
                   13047:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13048:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13049:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13050:        '">'.$linktext.'</a>';
1.153     matthew  13051: }
                   13052: 
                   13053: #######################################################
                   13054: #######################################################
                   13055: 
                   13056: =pod
                   13057: 
                   13058: =head1 Course Environment Routines
1.157     matthew  13059: 
                   13060: =over 4
1.153     matthew  13061: 
1.648     raeburn  13062: =item * &restore_course_settings()
1.153     matthew  13063: 
1.648     raeburn  13064: =item * &store_course_settings()
1.153     matthew  13065: 
                   13066: Restores/Store indicated form parameters from the course environment.
                   13067: Will not overwrite existing values of the form parameters.
                   13068: 
                   13069: Inputs: 
                   13070: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13071: 
                   13072: a hash ref describing the data to be stored.  For example:
                   13073:    
                   13074: %Save_Parameters = ('Status' => 'scalar',
                   13075:     'chartoutputmode' => 'scalar',
                   13076:     'chartoutputdata' => 'scalar',
                   13077:     'Section' => 'array',
1.373     raeburn  13078:     'Group' => 'array',
1.153     matthew  13079:     'StudentData' => 'array',
                   13080:     'Maps' => 'array');
                   13081: 
                   13082: Returns: both routines return nothing
                   13083: 
1.631     raeburn  13084: =back
                   13085: 
1.153     matthew  13086: =cut
                   13087: 
                   13088: #######################################################
                   13089: #######################################################
                   13090: sub store_course_settings {
1.496     albertel 13091:     return &store_settings($env{'request.course.id'},@_);
                   13092: }
                   13093: 
                   13094: sub store_settings {
1.153     matthew  13095:     # save to the environment
                   13096:     # appenv the same items, just to be safe
1.300     albertel 13097:     my $udom  = $env{'user.domain'};
                   13098:     my $uname = $env{'user.name'};
1.496     albertel 13099:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13100:     my %SaveHash;
                   13101:     my %AppHash;
                   13102:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13103:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13104:         my $envname = 'environment.'.$basename;
1.258     albertel 13105:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13106:             # Save this value away
                   13107:             if ($type eq 'scalar' &&
1.258     albertel 13108:                 (! exists($env{$envname}) || 
                   13109:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13110:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13111:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13112:             } elsif ($type eq 'array') {
                   13113:                 my $stored_form;
1.258     albertel 13114:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13115:                     $stored_form = join(',',
                   13116:                                         map {
1.369     www      13117:                                             &escape($_);
1.258     albertel 13118:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13119:                 } else {
                   13120:                     $stored_form = 
1.369     www      13121:                         &escape($env{'form.'.$setting});
1.153     matthew  13122:                 }
                   13123:                 # Determine if the array contents are the same.
1.258     albertel 13124:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13125:                     $SaveHash{$basename} = $stored_form;
                   13126:                     $AppHash{$envname}   = $stored_form;
                   13127:                 }
                   13128:             }
                   13129:         }
                   13130:     }
                   13131:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13132:                                           $udom,$uname);
1.153     matthew  13133:     if ($put_result !~ /^(ok|delayed)/) {
                   13134:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13135:                                  'got error:'.$put_result);
                   13136:     }
                   13137:     # Make sure these settings stick around in this session, too
1.646     raeburn  13138:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13139:     return;
                   13140: }
                   13141: 
                   13142: sub restore_course_settings {
1.499     albertel 13143:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13144: }
                   13145: 
                   13146: sub restore_settings {
                   13147:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13148:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13149:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13150:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13151:             '.'.$setting;
1.258     albertel 13152:         if (exists($env{$envname})) {
1.153     matthew  13153:             if ($type eq 'scalar') {
1.258     albertel 13154:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13155:             } elsif ($type eq 'array') {
1.258     albertel 13156:                 $env{'form.'.$setting} = [ 
1.153     matthew  13157:                                            map { 
1.369     www      13158:                                                &unescape($_); 
1.258     albertel 13159:                                            } split(',',$env{$envname})
1.153     matthew  13160:                                            ];
                   13161:             }
                   13162:         }
                   13163:     }
1.127     matthew  13164: }
                   13165: 
1.618     raeburn  13166: #######################################################
                   13167: #######################################################
                   13168: 
                   13169: =pod
                   13170: 
                   13171: =head1 Domain E-mail Routines  
                   13172: 
                   13173: =over 4
                   13174: 
1.648     raeburn  13175: =item * &build_recipient_list()
1.618     raeburn  13176: 
1.1144    raeburn  13177: Build recipient lists for following types of e-mail:
1.766     raeburn  13178: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144    raeburn  13179: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   13180: module change checking, student/employee ID conflict checks, as
                   13181: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   13182: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  13183: 
                   13184: Inputs:
1.619     raeburn  13185: defmail (scalar - email address of default recipient), 
1.1144    raeburn  13186: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   13187: requestsmail, updatesmail, or idconflictsmail).
                   13188: 
1.619     raeburn  13189: defdom (domain for which to retrieve configuration settings),
1.1144    raeburn  13190: 
1.619     raeburn  13191: origmail (scalar - email address of recipient from loncapa.conf, 
                   13192: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  13193: 
1.655     raeburn  13194: Returns: comma separated list of addresses to which to send e-mail.
                   13195: 
                   13196: =back
1.618     raeburn  13197: 
                   13198: =cut
                   13199: 
                   13200: ############################################################
                   13201: ############################################################
                   13202: sub build_recipient_list {
1.619     raeburn  13203:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13204:     my @recipients;
                   13205:     my $otheremails;
                   13206:     my %domconfig =
                   13207:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13208:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13209:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13210:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13211:                 my @contacts = ('adminemail','supportemail');
                   13212:                 foreach my $item (@contacts) {
                   13213:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13214:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13215:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13216:                             push(@recipients,$addr);
                   13217:                         }
1.619     raeburn  13218:                     }
1.766     raeburn  13219:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13220:                 }
                   13221:             }
1.766     raeburn  13222:         } elsif ($origmail ne '') {
                   13223:             push(@recipients,$origmail);
1.618     raeburn  13224:         }
1.619     raeburn  13225:     } elsif ($origmail ne '') {
                   13226:         push(@recipients,$origmail);
1.618     raeburn  13227:     }
1.688     raeburn  13228:     if (defined($defmail)) {
                   13229:         if ($defmail ne '') {
                   13230:             push(@recipients,$defmail);
                   13231:         }
1.618     raeburn  13232:     }
                   13233:     if ($otheremails) {
1.619     raeburn  13234:         my @others;
                   13235:         if ($otheremails =~ /,/) {
                   13236:             @others = split(/,/,$otheremails);
1.618     raeburn  13237:         } else {
1.619     raeburn  13238:             push(@others,$otheremails);
                   13239:         }
                   13240:         foreach my $addr (@others) {
                   13241:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13242:                 push(@recipients,$addr);
                   13243:             }
1.618     raeburn  13244:         }
                   13245:     }
1.619     raeburn  13246:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13247:     return $recipientlist;
                   13248: }
                   13249: 
1.127     matthew  13250: ############################################################
                   13251: ############################################################
1.154     albertel 13252: 
1.655     raeburn  13253: =pod
                   13254: 
                   13255: =head1 Course Catalog Routines
                   13256: 
                   13257: =over 4
                   13258: 
                   13259: =item * &gather_categories()
                   13260: 
                   13261: Converts category definitions - keys of categories hash stored in  
                   13262: coursecategories in configuration.db on the primary library server in a 
                   13263: domain - to an array.  Also generates javascript and idx hash used to 
                   13264: generate Domain Coordinator interface for editing Course Categories.
                   13265: 
                   13266: Inputs:
1.663     raeburn  13267: 
1.655     raeburn  13268: categories (reference to hash of category definitions).
1.663     raeburn  13269: 
1.655     raeburn  13270: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13271:       categories and subcategories).
1.663     raeburn  13272: 
1.655     raeburn  13273: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13274:       editing Course Categories).
1.663     raeburn  13275: 
1.655     raeburn  13276: jsarray (reference to array of categories used to create Javascript arrays for
                   13277:          Domain Coordinator interface for editing Course Categories).
                   13278: 
                   13279: Returns: nothing
                   13280: 
                   13281: Side effects: populates cats, idx and jsarray. 
                   13282: 
                   13283: =cut
                   13284: 
                   13285: sub gather_categories {
                   13286:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13287:     my %counters;
                   13288:     my $num = 0;
                   13289:     foreach my $item (keys(%{$categories})) {
                   13290:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13291:         if ($container eq '' && $depth == 0) {
                   13292:             $cats->[$depth][$categories->{$item}] = $cat;
                   13293:         } else {
                   13294:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13295:         }
                   13296:         my ($escitem,$tail) = split(/:/,$item,2);
                   13297:         if ($counters{$tail} eq '') {
                   13298:             $counters{$tail} = $num;
                   13299:             $num ++;
                   13300:         }
                   13301:         if (ref($idx) eq 'HASH') {
                   13302:             $idx->{$item} = $counters{$tail};
                   13303:         }
                   13304:         if (ref($jsarray) eq 'ARRAY') {
                   13305:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13306:         }
                   13307:     }
                   13308:     return;
                   13309: }
                   13310: 
                   13311: =pod
                   13312: 
                   13313: =item * &extract_categories()
                   13314: 
                   13315: Used to generate breadcrumb trails for course categories.
                   13316: 
                   13317: Inputs:
1.663     raeburn  13318: 
1.655     raeburn  13319: categories (reference to hash of category definitions).
1.663     raeburn  13320: 
1.655     raeburn  13321: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13322:       categories and subcategories).
1.663     raeburn  13323: 
1.655     raeburn  13324: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  13325: 
1.655     raeburn  13326: allitems (reference to hash - key is category key 
                   13327:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13328: 
1.655     raeburn  13329: idx (reference to hash of counters used in Domain Coordinator interface for
                   13330:       editing Course Categories).
1.663     raeburn  13331: 
1.655     raeburn  13332: jsarray (reference to array of categories used to create Javascript arrays for
                   13333:          Domain Coordinator interface for editing Course Categories).
                   13334: 
1.665     raeburn  13335: subcats (reference to hash of arrays containing all subcategories within each 
                   13336:          category, -recursive)
                   13337: 
1.655     raeburn  13338: Returns: nothing
                   13339: 
                   13340: Side effects: populates trails and allitems hash references.
                   13341: 
                   13342: =cut
                   13343: 
                   13344: sub extract_categories {
1.665     raeburn  13345:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  13346:     if (ref($categories) eq 'HASH') {
                   13347:         &gather_categories($categories,$cats,$idx,$jsarray);
                   13348:         if (ref($cats->[0]) eq 'ARRAY') {
                   13349:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   13350:                 my $name = $cats->[0][$i];
                   13351:                 my $item = &escape($name).'::0';
                   13352:                 my $trailstr;
                   13353:                 if ($name eq 'instcode') {
                   13354:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  13355:                 } elsif ($name eq 'communities') {
                   13356:                     $trailstr = &mt('Communities');
1.655     raeburn  13357:                 } else {
                   13358:                     $trailstr = $name;
                   13359:                 }
                   13360:                 if ($allitems->{$item} eq '') {
                   13361:                     push(@{$trails},$trailstr);
                   13362:                     $allitems->{$item} = scalar(@{$trails})-1;
                   13363:                 }
                   13364:                 my @parents = ($name);
                   13365:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   13366:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   13367:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  13368:                         if (ref($subcats) eq 'HASH') {
                   13369:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   13370:                         }
                   13371:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   13372:                     }
                   13373:                 } else {
                   13374:                     if (ref($subcats) eq 'HASH') {
                   13375:                         $subcats->{$item} = [];
1.655     raeburn  13376:                     }
                   13377:                 }
                   13378:             }
                   13379:         }
                   13380:     }
                   13381:     return;
                   13382: }
                   13383: 
                   13384: =pod
                   13385: 
                   13386: =item *&recurse_categories()
                   13387: 
                   13388: Recursively used to generate breadcrumb trails for course categories.
                   13389: 
                   13390: Inputs:
1.663     raeburn  13391: 
1.655     raeburn  13392: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13393:       categories and subcategories).
1.663     raeburn  13394: 
1.655     raeburn  13395: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  13396: 
                   13397: category (current course category, for which breadcrumb trail is being generated).
                   13398: 
                   13399: trails (reference to array of breadcrumb trails for each category).
                   13400: 
1.655     raeburn  13401: allitems (reference to hash - key is category key
                   13402:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13403: 
1.655     raeburn  13404: parents (array containing containers directories for current category, 
                   13405:          back to top level). 
                   13406: 
                   13407: Returns: nothing
                   13408: 
                   13409: Side effects: populates trails and allitems hash references
                   13410: 
                   13411: =cut
                   13412: 
                   13413: sub recurse_categories {
1.665     raeburn  13414:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  13415:     my $shallower = $depth - 1;
                   13416:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   13417:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   13418:             my $name = $cats->[$depth]{$category}[$k];
                   13419:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13420:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13421:             if ($allitems->{$item} eq '') {
                   13422:                 push(@{$trails},$trailstr);
                   13423:                 $allitems->{$item} = scalar(@{$trails})-1;
                   13424:             }
                   13425:             my $deeper = $depth+1;
                   13426:             push(@{$parents},$category);
1.665     raeburn  13427:             if (ref($subcats) eq 'HASH') {
                   13428:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   13429:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   13430:                     my $higher;
                   13431:                     if ($j > 0) {
                   13432:                         $higher = &escape($parents->[$j]).':'.
                   13433:                                   &escape($parents->[$j-1]).':'.$j;
                   13434:                     } else {
                   13435:                         $higher = &escape($parents->[$j]).'::'.$j;
                   13436:                     }
                   13437:                     push(@{$subcats->{$higher}},$subcat);
                   13438:                 }
                   13439:             }
                   13440:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   13441:                                 $subcats);
1.655     raeburn  13442:             pop(@{$parents});
                   13443:         }
                   13444:     } else {
                   13445:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13446:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13447:         if ($allitems->{$item} eq '') {
                   13448:             push(@{$trails},$trailstr);
                   13449:             $allitems->{$item} = scalar(@{$trails})-1;
                   13450:         }
                   13451:     }
                   13452:     return;
                   13453: }
                   13454: 
1.663     raeburn  13455: =pod
                   13456: 
                   13457: =item *&assign_categories_table()
                   13458: 
                   13459: Create a datatable for display of hierarchical categories in a domain,
                   13460: with checkboxes to allow a course to be categorized. 
                   13461: 
                   13462: Inputs:
                   13463: 
                   13464: cathash - reference to hash of categories defined for the domain (from
                   13465:           configuration.db)
                   13466: 
                   13467: currcat - scalar with an & separated list of categories assigned to a course. 
                   13468: 
1.919     raeburn  13469: type    - scalar contains course type (Course or Community).
                   13470: 
1.663     raeburn  13471: Returns: $output (markup to be displayed) 
                   13472: 
                   13473: =cut
                   13474: 
                   13475: sub assign_categories_table {
1.919     raeburn  13476:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13477:     my $output;
                   13478:     if (ref($cathash) eq 'HASH') {
                   13479:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13480:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13481:         $maxdepth = scalar(@cats);
                   13482:         if (@cats > 0) {
                   13483:             my $itemcount = 0;
                   13484:             if (ref($cats[0]) eq 'ARRAY') {
                   13485:                 my @currcategories;
                   13486:                 if ($currcat ne '') {
                   13487:                     @currcategories = split('&',$currcat);
                   13488:                 }
1.919     raeburn  13489:                 my $table;
1.663     raeburn  13490:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13491:                     my $parent = $cats[0][$i];
1.919     raeburn  13492:                     next if ($parent eq 'instcode');
                   13493:                     if ($type eq 'Community') {
                   13494:                         next unless ($parent eq 'communities');
                   13495:                     } else {
                   13496:                         next if ($parent eq 'communities');
                   13497:                     }
1.663     raeburn  13498:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13499:                     my $item = &escape($parent).'::0';
                   13500:                     my $checked = '';
                   13501:                     if (@currcategories > 0) {
                   13502:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13503:                             $checked = ' checked="checked"';
1.663     raeburn  13504:                         }
                   13505:                     }
1.919     raeburn  13506:                     my $parent_title = $parent;
                   13507:                     if ($parent eq 'communities') {
                   13508:                         $parent_title = &mt('Communities');
                   13509:                     }
                   13510:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13511:                               '<input type="checkbox" name="usecategory" value="'.
                   13512:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13513:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13514:                     my $depth = 1;
                   13515:                     push(@path,$parent);
1.919     raeburn  13516:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13517:                     pop(@path);
1.919     raeburn  13518:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13519:                     $itemcount ++;
                   13520:                 }
1.919     raeburn  13521:                 if ($itemcount) {
                   13522:                     $output = &Apache::loncommon::start_data_table().
                   13523:                               $table.
                   13524:                               &Apache::loncommon::end_data_table();
                   13525:                 }
1.663     raeburn  13526:             }
                   13527:         }
                   13528:     }
                   13529:     return $output;
                   13530: }
                   13531: 
                   13532: =pod
                   13533: 
                   13534: =item *&assign_category_rows()
                   13535: 
                   13536: Create a datatable row for display of nested categories in a domain,
                   13537: with checkboxes to allow a course to be categorized,called recursively.
                   13538: 
                   13539: Inputs:
                   13540: 
                   13541: itemcount - track row number for alternating colors
                   13542: 
                   13543: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13544:       categories and subcategories.
                   13545: 
                   13546: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13547: 
                   13548: parent - parent of current category item
                   13549: 
                   13550: path - Array containing all categories back up through the hierarchy from the
                   13551:        current category to the top level.
                   13552: 
                   13553: currcategories - reference to array of current categories assigned to the course
                   13554: 
                   13555: Returns: $output (markup to be displayed).
                   13556: 
                   13557: =cut
                   13558: 
                   13559: sub assign_category_rows {
                   13560:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13561:     my ($text,$name,$item,$chgstr);
                   13562:     if (ref($cats) eq 'ARRAY') {
                   13563:         my $maxdepth = scalar(@{$cats});
                   13564:         if (ref($cats->[$depth]) eq 'HASH') {
                   13565:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13566:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13567:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145    raeburn  13568:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  13569:                 for (my $j=0; $j<$numchildren; $j++) {
                   13570:                     $name = $cats->[$depth]{$parent}[$j];
                   13571:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13572:                     my $deeper = $depth+1;
                   13573:                     my $checked = '';
                   13574:                     if (ref($currcategories) eq 'ARRAY') {
                   13575:                         if (@{$currcategories} > 0) {
                   13576:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13577:                                 $checked = ' checked="checked"';
1.663     raeburn  13578:                             }
                   13579:                         }
                   13580:                     }
1.664     raeburn  13581:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13582:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13583:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13584:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13585:                              '</td><td>';
1.663     raeburn  13586:                     if (ref($path) eq 'ARRAY') {
                   13587:                         push(@{$path},$name);
                   13588:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13589:                         pop(@{$path});
                   13590:                     }
                   13591:                     $text .= '</td></tr>';
                   13592:                 }
                   13593:                 $text .= '</table></td>';
                   13594:             }
                   13595:         }
                   13596:     }
                   13597:     return $text;
                   13598: }
                   13599: 
1.655     raeburn  13600: ############################################################
                   13601: ############################################################
                   13602: 
                   13603: 
1.443     albertel 13604: sub commit_customrole {
1.664     raeburn  13605:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13606:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13607:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13608:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13609:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13610:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13611:                  '</b><br />';
                   13612:     return $output;
                   13613: }
                   13614: 
                   13615: sub commit_standardrole {
1.1116    raeburn  13616:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  13617:     my ($output,$logmsg,$linefeed);
                   13618:     if ($context eq 'auto') {
                   13619:         $linefeed = "\n";
                   13620:     } else {
                   13621:         $linefeed = "<br />\n";
                   13622:     }  
1.443     albertel 13623:     if ($three eq 'st') {
1.541     raeburn  13624:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116    raeburn  13625:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  13626:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13627:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13628:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13629:         } else {
1.541     raeburn  13630:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13631:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13632:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13633:             if ($context eq 'auto') {
                   13634:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13635:             } else {
                   13636:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13637:                &mt('Add to classlist').': <b>ok</b>';
                   13638:             }
                   13639:             $output .= $linefeed;
1.443     albertel 13640:         }
                   13641:     } else {
                   13642:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13643:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13644:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13645:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13646:         if ($context eq 'auto') {
                   13647:             $output .= $result.$linefeed;
                   13648:         } else {
                   13649:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13650:         }
1.443     albertel 13651:     }
                   13652:     return $output;
                   13653: }
                   13654: 
                   13655: sub commit_studentrole {
1.1116    raeburn  13656:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   13657:         $credits) = @_;
1.626     raeburn  13658:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13659:     if ($context eq 'auto') {
                   13660:         $linefeed = "\n";
                   13661:     } else {
                   13662:         $linefeed = '<br />'."\n";
                   13663:     }
1.443     albertel 13664:     if (defined($one) && defined($two)) {
                   13665:         my $cid=$one.'_'.$two;
                   13666:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13667:         my $secchange = 0;
                   13668:         my $expire_role_result;
                   13669:         my $modify_section_result;
1.628     raeburn  13670:         if ($oldsec ne '-1') { 
                   13671:             if ($oldsec ne $sec) {
1.443     albertel 13672:                 $secchange = 1;
1.628     raeburn  13673:                 my $now = time;
1.443     albertel 13674:                 my $uurl='/'.$cid;
                   13675:                 $uurl=~s/\_/\//g;
                   13676:                 if ($oldsec) {
                   13677:                     $uurl.='/'.$oldsec;
                   13678:                 }
1.626     raeburn  13679:                 $oldsecurl = $uurl;
1.628     raeburn  13680:                 $expire_role_result = 
1.652     raeburn  13681:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13682:                 if ($env{'request.course.sec'} ne '') { 
                   13683:                     if ($expire_role_result eq 'refused') {
                   13684:                         my @roles = ('st');
                   13685:                         my @statuses = ('previous');
                   13686:                         my @roledoms = ($one);
                   13687:                         my $withsec = 1;
                   13688:                         my %roleshash = 
                   13689:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13690:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13691:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13692:                             my ($oldstart,$oldend) = 
                   13693:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13694:                             if ($oldend > 0 && $oldend <= $now) {
                   13695:                                 $expire_role_result = 'ok';
                   13696:                             }
                   13697:                         }
                   13698:                     }
                   13699:                 }
1.443     albertel 13700:                 $result = $expire_role_result;
                   13701:             }
                   13702:         }
                   13703:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116    raeburn  13704:             $modify_section_result = 
                   13705:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   13706:                                                            undef,undef,undef,$sec,
                   13707:                                                            $end,$start,'','',$cid,
                   13708:                                                            '',$context,$credits);
1.443     albertel 13709:             if ($modify_section_result =~ /^ok/) {
                   13710:                 if ($secchange == 1) {
1.628     raeburn  13711:                     if ($sec eq '') {
                   13712:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13713:                     } else {
                   13714:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13715:                     }
1.443     albertel 13716:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13717:                     if ($sec eq '') {
                   13718:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13719:                     } else {
                   13720:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13721:                     }
1.443     albertel 13722:                 } else {
1.628     raeburn  13723:                     if ($sec eq '') {
                   13724:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13725:                     } else {
                   13726:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13727:                     }
1.443     albertel 13728:                 }
                   13729:             } else {
1.1115    raeburn  13730:                 if ($secchange) { 
1.628     raeburn  13731:                     $$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;
                   13732:                 } else {
                   13733:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13734:                 }
1.443     albertel 13735:             }
                   13736:             $result = $modify_section_result;
                   13737:         } elsif ($secchange == 1) {
1.628     raeburn  13738:             if ($oldsec eq '') {
1.1103    raeburn  13739:                 $$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  13740:             } else {
                   13741:                 $$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;
                   13742:             }
1.626     raeburn  13743:             if ($expire_role_result eq 'refused') {
                   13744:                 my $newsecurl = '/'.$cid;
                   13745:                 $newsecurl =~ s/\_/\//g;
                   13746:                 if ($sec ne '') {
                   13747:                     $newsecurl.='/'.$sec;
                   13748:                 }
                   13749:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13750:                     if ($sec eq '') {
                   13751:                         $$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;
                   13752:                     } else {
                   13753:                         $$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;
                   13754:                     }
                   13755:                 }
                   13756:             }
1.443     albertel 13757:         }
                   13758:     } else {
1.626     raeburn  13759:         $$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 13760:         $result = "error: incomplete course id\n";
                   13761:     }
                   13762:     return $result;
                   13763: }
                   13764: 
1.1108    raeburn  13765: sub show_role_extent {
                   13766:     my ($scope,$context,$role) = @_;
                   13767:     $scope =~ s{^/}{};
                   13768:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   13769:     push(@courseroles,'co');
                   13770:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   13771:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   13772:         $scope =~ s{/}{_};
                   13773:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   13774:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   13775:         my ($audom,$auname) = split(/\//,$scope);
                   13776:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   13777:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   13778:     } else {
                   13779:         $scope =~ s{/$}{};
                   13780:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   13781:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   13782:     }
                   13783: }
                   13784: 
1.443     albertel 13785: ############################################################
                   13786: ############################################################
                   13787: 
1.566     albertel 13788: sub check_clone {
1.578     raeburn  13789:     my ($args,$linefeed) = @_;
1.566     albertel 13790:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13791:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13792:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13793:     my $clonemsg;
                   13794:     my $can_clone = 0;
1.944     raeburn  13795:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13796:     if ($lctype ne 'community') {
                   13797:         $lctype = 'course';
                   13798:     }
1.566     albertel 13799:     if ($clonehome eq 'no_host') {
1.944     raeburn  13800:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13801:             $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'});
                   13802:         } else {
                   13803:             $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'});
                   13804:         }     
1.566     albertel 13805:     } else {
                   13806: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13807:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13808:             if ($clonedesc{'type'} ne 'Community') {
                   13809:                  $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'});
                   13810:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13811:             }
                   13812:         }
1.882     raeburn  13813: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13814:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13815: 	    $can_clone = 1;
                   13816: 	} else {
                   13817: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13818: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13819: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13820:             if (grep(/^\*$/,@cloners)) {
                   13821:                 $can_clone = 1;
                   13822:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13823:                 $can_clone = 1;
                   13824:             } else {
1.908     raeburn  13825:                 my $ccrole = 'cc';
1.944     raeburn  13826:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13827:                     $ccrole = 'co';
                   13828:                 }
1.578     raeburn  13829: 	        my %roleshash =
                   13830: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13831: 					 $args->{'ccdomain'},
1.908     raeburn  13832:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13833: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13834: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13835:                     $can_clone = 1;
                   13836:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13837:                     $can_clone = 1;
                   13838:                 } else {
1.944     raeburn  13839:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13840:                         $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'});
                   13841:                     } else {
                   13842:                         $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'});
                   13843:                     }
1.578     raeburn  13844: 	        }
1.566     albertel 13845: 	    }
1.578     raeburn  13846:         }
1.566     albertel 13847:     }
                   13848:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13849: }
                   13850: 
1.444     albertel 13851: sub construct_course {
1.885     raeburn  13852:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 13853:     my $outcome;
1.541     raeburn  13854:     my $linefeed =  '<br />'."\n";
                   13855:     if ($context eq 'auto') {
                   13856:         $linefeed = "\n";
                   13857:     }
1.566     albertel 13858: 
                   13859: #
                   13860: # Are we cloning?
                   13861: #
                   13862:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13863:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13864: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13865: 	if ($context ne 'auto') {
1.578     raeburn  13866:             if ($clonemsg ne '') {
                   13867: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13868:             }
1.566     albertel 13869: 	}
                   13870: 	$outcome .= $clonemsg.$linefeed;
                   13871: 
                   13872:         if (!$can_clone) {
                   13873: 	    return (0,$outcome);
                   13874: 	}
                   13875:     }
                   13876: 
1.444     albertel 13877: #
                   13878: # Open course
                   13879: #
                   13880:     my $crstype = lc($args->{'crstype'});
                   13881:     my %cenv=();
                   13882:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13883:                                              $args->{'cdescr'},
                   13884:                                              $args->{'curl'},
                   13885:                                              $args->{'course_home'},
                   13886:                                              $args->{'nonstandard'},
                   13887:                                              $args->{'crscode'},
                   13888:                                              $args->{'ccuname'}.':'.
                   13889:                                              $args->{'ccdomain'},
1.882     raeburn  13890:                                              $args->{'crstype'},
1.885     raeburn  13891:                                              $cnum,$context,$category);
1.444     albertel 13892: 
                   13893:     # Note: The testing routines depend on this being output; see 
                   13894:     # Utils::Course. This needs to at least be output as a comment
                   13895:     # if anyone ever decides to not show this, and Utils::Course::new
                   13896:     # will need to be suitably modified.
1.541     raeburn  13897:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13898:     if ($$courseid =~ /^error:/) {
                   13899:         return (0,$outcome);
                   13900:     }
                   13901: 
1.444     albertel 13902: #
                   13903: # Check if created correctly
                   13904: #
1.479     albertel 13905:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13906:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13907:     if ($crsuhome eq 'no_host') {
                   13908:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13909:         return (0,$outcome);
                   13910:     }
1.541     raeburn  13911:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13912: 
1.444     albertel 13913: #
1.566     albertel 13914: # Do the cloning
                   13915: #   
                   13916:     if ($can_clone && $cloneid) {
                   13917: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13918: 	if ($context ne 'auto') {
                   13919: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13920: 	}
                   13921: 	$outcome .= $clonemsg.$linefeed;
                   13922: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13923: # Copy all files
1.637     www      13924: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 13925: # Restore URL
1.566     albertel 13926: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 13927: # Restore title
1.566     albertel 13928: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  13929: # Restore creation date, creator and creation context.
                   13930:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   13931:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   13932:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 13933: # Mark as cloned
1.566     albertel 13934: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      13935: # Need to clone grading mode
                   13936:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   13937:         $cenv{'grading'}=$newenv{'grading'};
                   13938: # Do not clone these environment entries
                   13939:         &Apache::lonnet::del('environment',
                   13940:                   ['default_enrollment_start_date',
                   13941:                    'default_enrollment_end_date',
                   13942:                    'question.email',
                   13943:                    'policy.email',
                   13944:                    'comment.email',
                   13945:                    'pch.users.denied',
1.725     raeburn  13946:                    'plc.users.denied',
                   13947:                    'hidefromcat',
1.1121    raeburn  13948:                    'checkforpriv',
1.725     raeburn  13949:                    'categories'],
1.638     www      13950:                    $$crsudom,$$crsunum);
1.444     albertel 13951:     }
1.566     albertel 13952: 
1.444     albertel 13953: #
                   13954: # Set environment (will override cloned, if existing)
                   13955: #
                   13956:     my @sections = ();
                   13957:     my @xlists = ();
                   13958:     if ($args->{'crstype'}) {
                   13959:         $cenv{'type'}=$args->{'crstype'};
                   13960:     }
                   13961:     if ($args->{'crsid'}) {
                   13962:         $cenv{'courseid'}=$args->{'crsid'};
                   13963:     }
                   13964:     if ($args->{'crscode'}) {
                   13965:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   13966:     }
                   13967:     if ($args->{'crsquota'} ne '') {
                   13968:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   13969:     } else {
                   13970:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   13971:     }
                   13972:     if ($args->{'ccuname'}) {
                   13973:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   13974:                                         ':'.$args->{'ccdomain'};
                   13975:     } else {
                   13976:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   13977:     }
1.1116    raeburn  13978:     if ($args->{'defaultcredits'}) {
                   13979:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   13980:     }
1.444     albertel 13981:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   13982:     if ($args->{'crssections'}) {
                   13983:         $cenv{'internal.sectionnums'} = '';
                   13984:         if ($args->{'crssections'} =~ m/,/) {
                   13985:             @sections = split/,/,$args->{'crssections'};
                   13986:         } else {
                   13987:             $sections[0] = $args->{'crssections'};
                   13988:         }
                   13989:         if (@sections > 0) {
                   13990:             foreach my $item (@sections) {
                   13991:                 my ($sec,$gp) = split/:/,$item;
                   13992:                 my $class = $args->{'crscode'}.$sec;
                   13993:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   13994:                 $cenv{'internal.sectionnums'} .= $item.',';
                   13995:                 unless ($addcheck eq 'ok') {
                   13996:                     push @badclasses, $class;
                   13997:                 }
                   13998:             }
                   13999:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   14000:         }
                   14001:     }
                   14002: # do not hide course coordinator from staff listing, 
                   14003: # even if privileged
                   14004:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121    raeburn  14005: # add course coordinator's domain to domains to check for privileged users
                   14006: # if different to course domain
                   14007:     if ($$crsudom ne $args->{'ccdomain'}) {
                   14008:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   14009:     }
1.444     albertel 14010: # add crosslistings
                   14011:     if ($args->{'crsxlist'}) {
                   14012:         $cenv{'internal.crosslistings'}='';
                   14013:         if ($args->{'crsxlist'} =~ m/,/) {
                   14014:             @xlists = split/,/,$args->{'crsxlist'};
                   14015:         } else {
                   14016:             $xlists[0] = $args->{'crsxlist'};
                   14017:         }
                   14018:         if (@xlists > 0) {
                   14019:             foreach my $item (@xlists) {
                   14020:                 my ($xl,$gp) = split/:/,$item;
                   14021:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   14022:                 $cenv{'internal.crosslistings'} .= $item.',';
                   14023:                 unless ($addcheck eq 'ok') {
                   14024:                     push @badclasses, $xl;
                   14025:                 }
                   14026:             }
                   14027:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   14028:         }
                   14029:     }
                   14030:     if ($args->{'autoadds'}) {
                   14031:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   14032:     }
                   14033:     if ($args->{'autodrops'}) {
                   14034:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   14035:     }
                   14036: # check for notification of enrollment changes
                   14037:     my @notified = ();
                   14038:     if ($args->{'notify_owner'}) {
                   14039:         if ($args->{'ccuname'} ne '') {
                   14040:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   14041:         }
                   14042:     }
                   14043:     if ($args->{'notify_dc'}) {
                   14044:         if ($uname ne '') { 
1.630     raeburn  14045:             push(@notified,$uname.':'.$udom);
1.444     albertel 14046:         }
                   14047:     }
                   14048:     if (@notified > 0) {
                   14049:         my $notifylist;
                   14050:         if (@notified > 1) {
                   14051:             $notifylist = join(',',@notified);
                   14052:         } else {
                   14053:             $notifylist = $notified[0];
                   14054:         }
                   14055:         $cenv{'internal.notifylist'} = $notifylist;
                   14056:     }
                   14057:     if (@badclasses > 0) {
                   14058:         my %lt=&Apache::lonlocal::texthash(
                   14059:                 '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',
                   14060:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   14061:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   14062:         );
1.541     raeburn  14063:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   14064:                            ' ('.$lt{'adby'}.')';
                   14065:         if ($context eq 'auto') {
                   14066:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 14067:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  14068:             foreach my $item (@badclasses) {
                   14069:                 if ($context eq 'auto') {
                   14070:                     $outcome .= " - $item\n";
                   14071:                 } else {
                   14072:                     $outcome .= "<li>$item</li>\n";
                   14073:                 }
                   14074:             }
                   14075:             if ($context eq 'auto') {
                   14076:                 $outcome .= $linefeed;
                   14077:             } else {
1.566     albertel 14078:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14079:             }
                   14080:         } 
1.444     albertel 14081:     }
                   14082:     if ($args->{'no_end_date'}) {
                   14083:         $args->{'endaccess'} = 0;
                   14084:     }
                   14085:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14086:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14087:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14088:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14089:     if ($args->{'showphotos'}) {
                   14090:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14091:     }
                   14092:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14093:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14094:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14095:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14096:             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'); 
                   14097:             if ($context eq 'auto') {
                   14098:                 $outcome .= $krb_msg;
                   14099:             } else {
1.566     albertel 14100:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14101:             }
                   14102:             $outcome .= $linefeed;
1.444     albertel 14103:         }
                   14104:     }
                   14105:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14106:        if ($args->{'setpolicy'}) {
                   14107:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14108:        }
                   14109:        if ($args->{'setcontent'}) {
                   14110:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14111:        }
                   14112:     }
                   14113:     if ($args->{'reshome'}) {
                   14114: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14115: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14116:     }
                   14117: #
                   14118: # course has keyed access
                   14119: #
                   14120:     if ($args->{'setkeys'}) {
                   14121:        $cenv{'keyaccess'}='yes';
                   14122:     }
                   14123: # if specified, key authority is not course, but user
                   14124: # only active if keyaccess is yes
                   14125:     if ($args->{'keyauth'}) {
1.487     albertel 14126: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14127: 	$user = &LONCAPA::clean_username($user);
                   14128: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14129: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14130: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14131: 	}
                   14132:     }
                   14133: 
                   14134:     if ($args->{'disresdis'}) {
                   14135:         $cenv{'pch.roles.denied'}='st';
                   14136:     }
                   14137:     if ($args->{'disablechat'}) {
                   14138:         $cenv{'plc.roles.denied'}='st';
                   14139:     }
                   14140: 
                   14141:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14142:     # course
                   14143:     $cenv{'course.helper.not.run'} = 1;
                   14144:     #
                   14145:     # Use new Randomseed
                   14146:     #
                   14147:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14148:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14149:     #
                   14150:     # The encryption code and receipt prefix for this course
                   14151:     #
                   14152:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14153:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14154:     #
                   14155:     # By default, use standard grading
                   14156:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14157: 
1.541     raeburn  14158:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14159:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14160: #
                   14161: # Open all assignments
                   14162: #
                   14163:     if ($args->{'openall'}) {
                   14164:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14165:        my %storecontent = ($storeunder         => time,
                   14166:                            $storeunder.'.type' => 'date_start');
                   14167:        
                   14168:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14169:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14170:    }
                   14171: #
                   14172: # Set first page
                   14173: #
                   14174:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14175: 	    || ($cloneid)) {
1.445     albertel 14176: 	use LONCAPA::map;
1.444     albertel 14177: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14178: 
                   14179: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14180:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14181: 
1.444     albertel 14182:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14183:         my $title; my $url;
                   14184:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14185: 	    $title=&mt('Syllabus');
1.444     albertel 14186:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14187:         } else {
1.963     raeburn  14188:             $title=&mt('Table of Contents');
1.444     albertel 14189:             $url='/adm/navmaps';
                   14190:         }
1.445     albertel 14191: 
                   14192:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14193: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14194: 
                   14195: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14196:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14197:     }
1.566     albertel 14198: 
                   14199:     return (1,$outcome);
1.444     albertel 14200: }
                   14201: 
                   14202: ############################################################
                   14203: ############################################################
                   14204: 
1.953     droeschl 14205: #SD
                   14206: # only Community and Course, or anything else?
1.378     raeburn  14207: sub course_type {
                   14208:     my ($cid) = @_;
                   14209:     if (!defined($cid)) {
                   14210:         $cid = $env{'request.course.id'};
                   14211:     }
1.404     albertel 14212:     if (defined($env{'course.'.$cid.'.type'})) {
                   14213:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  14214:     } else {
                   14215:         return 'Course';
1.377     raeburn  14216:     }
                   14217: }
1.156     albertel 14218: 
1.406     raeburn  14219: sub group_term {
                   14220:     my $crstype = &course_type();
                   14221:     my %names = (
                   14222:                   'Course' => 'group',
1.865     raeburn  14223:                   'Community' => 'group',
1.406     raeburn  14224:                 );
                   14225:     return $names{$crstype};
                   14226: }
                   14227: 
1.902     raeburn  14228: sub course_types {
                   14229:     my @types = ('official','unofficial','community');
                   14230:     my %typename = (
                   14231:                          official   => 'Official course',
                   14232:                          unofficial => 'Unofficial course',
                   14233:                          community  => 'Community',
                   14234:                    );
                   14235:     return (\@types,\%typename);
                   14236: }
                   14237: 
1.156     albertel 14238: sub icon {
                   14239:     my ($file)=@_;
1.505     albertel 14240:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 14241:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 14242:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 14243:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   14244: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   14245: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14246: 	            $curfext.".gif") {
                   14247: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14248: 		$curfext.".gif";
                   14249: 	}
                   14250:     }
1.249     albertel 14251:     return &lonhttpdurl($iconname);
1.154     albertel 14252: } 
1.84      albertel 14253: 
1.575     albertel 14254: sub lonhttpdurl {
1.692     www      14255: #
                   14256: # Had been used for "small fry" static images on separate port 8080.
                   14257: # Modify here if lightweight http functionality desired again.
                   14258: # Currently eliminated due to increasing firewall issues.
                   14259: #
1.575     albertel 14260:     my ($url)=@_;
1.692     www      14261:     return $url;
1.215     albertel 14262: }
                   14263: 
1.213     albertel 14264: sub connection_aborted {
                   14265:     my ($r)=@_;
                   14266:     $r->print(" ");$r->rflush();
                   14267:     my $c = $r->connection;
                   14268:     return $c->aborted();
                   14269: }
                   14270: 
1.221     foxr     14271: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     14272: #    strings as 'strings'.
                   14273: sub escape_single {
1.221     foxr     14274:     my ($input) = @_;
1.223     albertel 14275:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     14276:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   14277:     return $input;
                   14278: }
1.223     albertel 14279: 
1.222     foxr     14280: #  Same as escape_single, but escape's "'s  This 
                   14281: #  can be used for  "strings"
                   14282: sub escape_double {
                   14283:     my ($input) = @_;
                   14284:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   14285:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   14286:     return $input;
                   14287: }
1.223     albertel 14288:  
1.222     foxr     14289: #   Escapes the last element of a full URL.
                   14290: sub escape_url {
                   14291:     my ($url)   = @_;
1.238     raeburn  14292:     my @urlslices = split(/\//, $url,-1);
1.369     www      14293:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 14294:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     14295: }
1.462     albertel 14296: 
1.820     raeburn  14297: sub compare_arrays {
                   14298:     my ($arrayref1,$arrayref2) = @_;
                   14299:     my (@difference,%count);
                   14300:     @difference = ();
                   14301:     %count = ();
                   14302:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   14303:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   14304:         foreach my $element (keys(%count)) {
                   14305:             if ($count{$element} == 1) {
                   14306:                 push(@difference,$element);
                   14307:             }
                   14308:         }
                   14309:     }
                   14310:     return @difference;
                   14311: }
                   14312: 
1.817     bisitz   14313: # -------------------------------------------------------- Initialize user login
1.462     albertel 14314: sub init_user_environment {
1.463     albertel 14315:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 14316:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   14317: 
                   14318:     my $public=($username eq 'public' && $domain eq 'public');
                   14319: 
                   14320: # See if old ID present, if so, remove
                   14321: 
1.1062    raeburn  14322:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 14323:     my $now=time;
                   14324: 
                   14325:     if ($public) {
                   14326: 	my $max_public=100;
                   14327: 	my $oldest;
                   14328: 	my $oldest_time=0;
                   14329: 	for(my $next=1;$next<=$max_public;$next++) {
                   14330: 	    if (-e $lonids."/publicuser_$next.id") {
                   14331: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   14332: 		if ($mtime<$oldest_time || !$oldest_time) {
                   14333: 		    $oldest_time=$mtime;
                   14334: 		    $oldest=$next;
                   14335: 		}
                   14336: 	    } else {
                   14337: 		$cookie="publicuser_$next";
                   14338: 		last;
                   14339: 	    }
                   14340: 	}
                   14341: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   14342:     } else {
1.463     albertel 14343: 	# if this isn't a robot, kill any existing non-robot sessions
                   14344: 	if (!$args->{'robot'}) {
                   14345: 	    opendir(DIR,$lonids);
                   14346: 	    while ($filename=readdir(DIR)) {
                   14347: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   14348: 		    unlink($lonids.'/'.$filename);
                   14349: 		}
1.462     albertel 14350: 	    }
1.463     albertel 14351: 	    closedir(DIR);
1.462     albertel 14352: 	}
                   14353: # Give them a new cookie
1.463     albertel 14354: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      14355: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 14356: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 14357:     
                   14358: # Initialize roles
                   14359: 
1.1062    raeburn  14360: 	($userroles,$firstaccenv,$timerintenv) = 
                   14361:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 14362:     }
                   14363: # ------------------------------------ Check browser type and MathML capability
                   14364: 
                   14365:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1141    raeburn  14366:         $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
1.462     albertel 14367: 
                   14368: # ------------------------------------------------------------- Get environment
                   14369: 
                   14370:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   14371:     my ($tmp) = keys(%userenv);
                   14372:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   14373:     } else {
                   14374: 	undef(%userenv);
                   14375:     }
                   14376:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   14377: 	$form->{'interface'}=$userenv{'interface'};
                   14378:     }
                   14379:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   14380: 
                   14381: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   14382:     foreach my $option ('interface','localpath','localres') {
                   14383:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 14384:     }
                   14385: # --------------------------------------------------------- Write first profile
                   14386: 
                   14387:     {
                   14388: 	my %initial_env = 
                   14389: 	    ("user.name"          => $username,
                   14390: 	     "user.domain"        => $domain,
                   14391: 	     "user.home"          => $authhost,
                   14392: 	     "browser.type"       => $clientbrowser,
                   14393: 	     "browser.version"    => $clientversion,
                   14394: 	     "browser.mathml"     => $clientmathml,
                   14395: 	     "browser.unicode"    => $clientunicode,
                   14396: 	     "browser.os"         => $clientos,
1.1137    raeburn  14397:              "browser.mobile"     => $clientmobile,
1.1141    raeburn  14398:              "browser.info"       => $clientinfo,
1.462     albertel 14399: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   14400: 	     "request.course.fn"  => '',
                   14401: 	     "request.course.uri" => '',
                   14402: 	     "request.course.sec" => '',
                   14403: 	     "request.role"       => 'cm',
                   14404: 	     "request.role.adv"   => $env{'user.adv'},
                   14405: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   14406: 
                   14407:         if ($form->{'localpath'}) {
                   14408: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   14409: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   14410:         }
                   14411: 	
                   14412: 	if ($form->{'interface'}) {
                   14413: 	    $form->{'interface'}=~s/\W//gs;
                   14414: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   14415: 	    $env{'browser.interface'}=$form->{'interface'};
                   14416: 	}
                   14417: 
1.1157    raeburn  14418:         if ($form->{'iptoken'}) {
                   14419:             my $lonhost = $r->dir_config('lonHostID');
                   14420:             $initial_env{"user.noloadbalance"} = $lonhost;
                   14421:             $env{'user.noloadbalance'} = $lonhost;
                   14422:         }
                   14423: 
1.981     raeburn  14424:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  14425:         my %domdef;
                   14426:         unless ($domain eq 'public') {
                   14427:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   14428:         }
1.980     raeburn  14429: 
1.1081    raeburn  14430:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  14431:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  14432:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   14433:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  14434:         }
                   14435: 
1.864     raeburn  14436:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  14437:             $userenv{'canrequest.'.$crstype} =
                   14438:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  14439:                                                   'reload','requestcourses',
                   14440:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  14441:         }
                   14442: 
1.1092    raeburn  14443:         $userenv{'canrequest.author'} =
                   14444:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   14445:                                         'reload','requestauthor',
                   14446:                                         \%userenv,\%domdef,\%is_adv);
                   14447:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   14448:                                              $domain,$username);
                   14449:         my $reqstatus = $reqauthor{'author_status'};
                   14450:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   14451:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   14452:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   14453:                                                   $reqauthor{'author'}{'timestamp'};
                   14454:             }
                   14455:         }
                   14456: 
1.462     albertel 14457: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  14458: 
1.462     albertel 14459: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   14460: 		 &GDBM_WRCREAT(),0640)) {
                   14461: 	    &_add_to_env(\%disk_env,\%initial_env);
                   14462: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   14463: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  14464:             if (ref($firstaccenv) eq 'HASH') {
                   14465:                 &_add_to_env(\%disk_env,$firstaccenv);
                   14466:             }
                   14467:             if (ref($timerintenv) eq 'HASH') {
                   14468:                 &_add_to_env(\%disk_env,$timerintenv);
                   14469:             }
1.463     albertel 14470: 	    if (ref($args->{'extra_env'})) {
                   14471: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   14472: 	    }
1.462     albertel 14473: 	    untie(%disk_env);
                   14474: 	} else {
1.705     tempelho 14475: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   14476: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 14477: 	    return 'error: '.$!;
                   14478: 	}
                   14479:     }
                   14480:     $env{'request.role'}='cm';
                   14481:     $env{'request.role.adv'}=$env{'user.adv'};
                   14482:     $env{'browser.type'}=$clientbrowser;
                   14483: 
                   14484:     return $cookie;
                   14485: 
                   14486: }
                   14487: 
                   14488: sub _add_to_env {
                   14489:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14490:     if (ref($env_data) eq 'HASH') {
                   14491:         while (my ($key,$value) = each(%$env_data)) {
                   14492: 	    $idf->{$prefix.$key} = $value;
                   14493: 	    $env{$prefix.$key}   = $value;
                   14494:         }
1.462     albertel 14495:     }
                   14496: }
                   14497: 
1.685     tempelho 14498: # --- Get the symbolic name of a problem and the url
                   14499: sub get_symb {
                   14500:     my ($request,$silent) = @_;
1.726     raeburn  14501:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14502:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14503:     if ($symb eq '') {
                   14504:         if (!$silent) {
1.1071    raeburn  14505:             if (ref($request)) { 
                   14506:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14507:             }
1.685     tempelho 14508:             return ();
                   14509:         }
                   14510:     }
                   14511:     &Apache::lonenc::check_decrypt(\$symb);
                   14512:     return ($symb);
                   14513: }
                   14514: 
                   14515: # --------------------------------------------------------------Get annotation
                   14516: 
                   14517: sub get_annotation {
                   14518:     my ($symb,$enc) = @_;
                   14519: 
                   14520:     my $key = $symb;
                   14521:     if (!$enc) {
                   14522:         $key =
                   14523:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14524:     }
                   14525:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14526:     return $annotation{$key};
                   14527: }
                   14528: 
                   14529: sub clean_symb {
1.731     raeburn  14530:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14531: 
                   14532:     &Apache::lonenc::check_decrypt(\$symb);
                   14533:     my $enc = $env{'request.enc'};
1.731     raeburn  14534:     if ($delete_enc) {
1.730     raeburn  14535:         delete($env{'request.enc'});
                   14536:     }
1.685     tempelho 14537: 
                   14538:     return ($symb,$enc);
                   14539: }
1.462     albertel 14540: 
1.990     raeburn  14541: sub build_release_hashes {
                   14542:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   14543:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   14544:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   14545:                   (ref($randomizetry) eq 'HASH'));
                   14546:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14547:         my ($item,$name,$value) = split(/:/,$key);
                   14548:         if ($item eq 'parameter') {
                   14549:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   14550:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   14551:                     push(@{$checkparms->{$name}},$value);
                   14552:                 }
                   14553:             } else {
                   14554:                 push(@{$checkparms->{$name}},$value);
                   14555:             }
                   14556:         } elsif ($item eq 'resourcetag') {
                   14557:             if ($name eq 'responsetype') {
                   14558:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   14559:             }
                   14560:         } elsif ($item eq 'course') {
                   14561:             if ($name eq 'crstype') {
                   14562:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   14563:             }
                   14564:         }
                   14565:     }
                   14566:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   14567:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   14568:     return;
                   14569: }
                   14570: 
1.1083    raeburn  14571: sub update_content_constraints {
                   14572:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14573:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   14574:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   14575:     my %checkresponsetypes;
                   14576:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14577:         my ($item,$name,$value) = split(/:/,$key);
                   14578:         if ($item eq 'resourcetag') {
                   14579:             if ($name eq 'responsetype') {
                   14580:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   14581:             }
                   14582:         }
                   14583:     }
                   14584:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14585:     if (defined($navmap)) {
                   14586:         my %allresponses;
                   14587:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   14588:             my %responses = $res->responseTypes();
                   14589:             foreach my $key (keys(%responses)) {
                   14590:                 next unless(exists($checkresponsetypes{$key}));
                   14591:                 $allresponses{$key} += $responses{$key};
                   14592:             }
                   14593:         }
                   14594:         foreach my $key (keys(%allresponses)) {
                   14595:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   14596:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   14597:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   14598:             }
                   14599:         }
                   14600:         undef($navmap);
                   14601:     }
                   14602:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   14603:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   14604:     }
                   14605:     return;
                   14606: }
                   14607: 
1.1110    raeburn  14608: sub allmaps_incourse {
                   14609:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14610:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   14611:         $cid = $env{'request.course.id'};
                   14612:         $cdom = $env{'course.'.$cid.'.domain'};
                   14613:         $cnum = $env{'course.'.$cid.'.num'};
                   14614:         $chome = $env{'course.'.$cid.'.home'};
                   14615:     }
                   14616:     my %allmaps = ();
                   14617:     my $lastchange =
                   14618:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   14619:     if ($lastchange > $env{'request.course.tied'}) {
                   14620:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   14621:         unless ($ferr) {
                   14622:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   14623:         }
                   14624:     }
                   14625:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14626:     if (defined($navmap)) {
                   14627:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   14628:             $allmaps{$res->src()} = 1;
                   14629:         }
                   14630:     }
                   14631:     return \%allmaps;
                   14632: }
                   14633: 
1.1083    raeburn  14634: sub parse_supplemental_title {
                   14635:     my ($title) = @_;
                   14636: 
                   14637:     my ($foldertitle,$renametitle);
                   14638:     if ($title =~ /&amp;&amp;&amp;/) {
                   14639:         $title = &HTML::Entites::decode($title);
                   14640:     }
                   14641:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   14642:         $renametitle=$4;
                   14643:         my ($time,$uname,$udom) = ($1,$2,$3);
                   14644:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   14645:         my $name =  &plainname($uname,$udom);
                   14646:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   14647:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   14648:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   14649:             $name.': <br />'.$foldertitle;
                   14650:     }
                   14651:     if (wantarray) {
                   14652:         return ($title,$foldertitle,$renametitle);
                   14653:     }
                   14654:     return $title;
                   14655: }
                   14656: 
1.1143    raeburn  14657: sub recurse_supplemental {
                   14658:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   14659:     if ($suppmap) {
                   14660:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   14661:         if ($fatal) {
                   14662:             $errors ++;
                   14663:         } else {
                   14664:             if ($#LONCAPA::map::resources > 0) {
                   14665:                 foreach my $res (@LONCAPA::map::resources) {
                   14666:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   14667:                     if (($src ne '') && ($status eq 'res')) {
1.1146    raeburn  14668:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   14669:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143    raeburn  14670:                         } else {
                   14671:                             $numfiles ++;
                   14672:                         }
                   14673:                     }
                   14674:                 }
                   14675:             }
                   14676:         }
                   14677:     }
                   14678:     return ($numfiles,$errors);
                   14679: }
                   14680: 
1.1101    raeburn  14681: sub symb_to_docspath {
                   14682:     my ($symb) = @_;
                   14683:     return unless ($symb);
                   14684:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   14685:     if ($resurl=~/\.(sequence|page)$/) {
                   14686:         $mapurl=$resurl;
                   14687:     } elsif ($resurl eq 'adm/navmaps') {
                   14688:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   14689:     }
                   14690:     my $mapresobj;
                   14691:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14692:     if (ref($navmap)) {
                   14693:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   14694:     }
                   14695:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   14696:     my $type=$2;
                   14697:     my $path;
                   14698:     if (ref($mapresobj)) {
                   14699:         my $pcslist = $mapresobj->map_hierarchy();
                   14700:         if ($pcslist ne '') {
                   14701:             foreach my $pc (split(/,/,$pcslist)) {
                   14702:                 next if ($pc <= 1);
                   14703:                 my $res = $navmap->getByMapPc($pc);
                   14704:                 if (ref($res)) {
                   14705:                     my $thisurl = $res->src();
                   14706:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   14707:                     my $thistitle = $res->title();
                   14708:                     $path .= '&'.
                   14709:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146    raeburn  14710:                              &escape($thistitle).
1.1101    raeburn  14711:                              ':'.$res->randompick().
                   14712:                              ':'.$res->randomout().
                   14713:                              ':'.$res->encrypted().
                   14714:                              ':'.$res->randomorder().
                   14715:                              ':'.$res->is_page();
                   14716:                 }
                   14717:             }
                   14718:         }
                   14719:         $path =~ s/^\&//;
                   14720:         my $maptitle = $mapresobj->title();
                   14721:         if ($mapurl eq 'default') {
1.1129    raeburn  14722:             $maptitle = 'Main Content';
1.1101    raeburn  14723:         }
                   14724:         $path .= (($path ne '')? '&' : '').
                   14725:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  14726:                  &escape($maptitle).
1.1101    raeburn  14727:                  ':'.$mapresobj->randompick().
                   14728:                  ':'.$mapresobj->randomout().
                   14729:                  ':'.$mapresobj->encrypted().
                   14730:                  ':'.$mapresobj->randomorder().
                   14731:                  ':'.$mapresobj->is_page();
                   14732:     } else {
                   14733:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   14734:         my $ispage = (($type eq 'page')? 1 : '');
                   14735:         if ($mapurl eq 'default') {
1.1129    raeburn  14736:             $maptitle = 'Main Content';
1.1101    raeburn  14737:         }
                   14738:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  14739:                 &escape($maptitle).':::::'.$ispage;
1.1101    raeburn  14740:     }
                   14741:     unless ($mapurl eq 'default') {
                   14742:         $path = 'default&'.
1.1146    raeburn  14743:                 &escape('Main Content').
1.1101    raeburn  14744:                 ':::::&'.$path;
                   14745:     }
                   14746:     return $path;
                   14747: }
                   14748: 
1.1094    raeburn  14749: sub captcha_display {
                   14750:     my ($context,$lonhost) = @_;
                   14751:     my ($output,$error);
                   14752:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  14753:     if ($captcha eq 'original') {
1.1094    raeburn  14754:         $output = &create_captcha();
                   14755:         unless ($output) {
                   14756:             $error = 'captcha'; 
                   14757:         }
                   14758:     } elsif ($captcha eq 'recaptcha') {
                   14759:         $output = &create_recaptcha($pubkey);
                   14760:         unless ($output) {
1.1095    raeburn  14761:             $error = 'recaptcha'; 
1.1094    raeburn  14762:         }
                   14763:     }
                   14764:     return ($output,$error);
                   14765: }
                   14766: 
                   14767: sub captcha_response {
                   14768:     my ($context,$lonhost) = @_;
                   14769:     my ($captcha_chk,$captcha_error);
                   14770:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  14771:     if ($captcha eq 'original') {
1.1094    raeburn  14772:         ($captcha_chk,$captcha_error) = &check_captcha();
                   14773:     } elsif ($captcha eq 'recaptcha') {
                   14774:         $captcha_chk = &check_recaptcha($privkey);
                   14775:     } else {
                   14776:         $captcha_chk = 1;
                   14777:     }
                   14778:     return ($captcha_chk,$captcha_error);
                   14779: }
                   14780: 
                   14781: sub get_captcha_config {
                   14782:     my ($context,$lonhost) = @_;
1.1095    raeburn  14783:     my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094    raeburn  14784:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   14785:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   14786:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095    raeburn  14787:     if ($context eq 'usercreation') {
                   14788:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   14789:         if (ref($domconfig{$context}) eq 'HASH') {
                   14790:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   14791:             if (ref($hashtocheck) eq 'HASH') {
                   14792:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   14793:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   14794:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   14795:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   14796:                     }
                   14797:                     if ($privkey && $pubkey) {
                   14798:                         $captcha = 'recaptcha';
                   14799:                     } else {
                   14800:                         $captcha = 'original';
                   14801:                     }
                   14802:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   14803:                     $captcha = 'original';
                   14804:                 }
1.1094    raeburn  14805:             }
1.1095    raeburn  14806:         } else {
                   14807:             $captcha = 'captcha';
                   14808:         }
                   14809:     } elsif ($context eq 'login') {
                   14810:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   14811:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   14812:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   14813:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094    raeburn  14814:             if ($privkey && $pubkey) {
                   14815:                 $captcha = 'recaptcha';
1.1095    raeburn  14816:             } else {
                   14817:                 $captcha = 'original';
1.1094    raeburn  14818:             }
1.1095    raeburn  14819:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   14820:             $captcha = 'original';
1.1094    raeburn  14821:         }
                   14822:     }
                   14823:     return ($captcha,$pubkey,$privkey);
                   14824: }
                   14825: 
                   14826: sub create_captcha {
                   14827:     my %captcha_params = &captcha_settings();
                   14828:     my ($output,$maxtries,$tries) = ('',10,0);
                   14829:     while ($tries < $maxtries) {
                   14830:         $tries ++;
                   14831:         my $captcha = Authen::Captcha->new (
                   14832:                                            output_folder => $captcha_params{'output_dir'},
                   14833:                                            data_folder   => $captcha_params{'db_dir'},
                   14834:                                           );
                   14835:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   14836: 
                   14837:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   14838:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   14839:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
                   14840:                      '<input type="text" size="5" name="code" value="" /><br />'.
                   14841:                      '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
                   14842:             last;
                   14843:         }
                   14844:     }
                   14845:     return $output;
                   14846: }
                   14847: 
                   14848: sub captcha_settings {
                   14849:     my %captcha_params = (
                   14850:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   14851:                            www_output_dir => "/captchaspool",
                   14852:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   14853:                            numchars       => '5',
                   14854:                          );
                   14855:     return %captcha_params;
                   14856: }
                   14857: 
                   14858: sub check_captcha {
                   14859:     my ($captcha_chk,$captcha_error);
                   14860:     my $code = $env{'form.code'};
                   14861:     my $md5sum = $env{'form.crypt'};
                   14862:     my %captcha_params = &captcha_settings();
                   14863:     my $captcha = Authen::Captcha->new(
                   14864:                       output_folder => $captcha_params{'output_dir'},
                   14865:                       data_folder   => $captcha_params{'db_dir'},
                   14866:                   );
1.1109    raeburn  14867:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094    raeburn  14868:     my %captcha_hash = (
                   14869:                         0       => 'Code not checked (file error)',
                   14870:                        -1      => 'Failed: code expired',
                   14871:                        -2      => 'Failed: invalid code (not in database)',
                   14872:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   14873:     );
                   14874:     if ($captcha_chk != 1) {
                   14875:         $captcha_error = $captcha_hash{$captcha_chk}
                   14876:     }
                   14877:     return ($captcha_chk,$captcha_error);
                   14878: }
                   14879: 
                   14880: sub create_recaptcha {
                   14881:     my ($pubkey) = @_;
1.1153    raeburn  14882:     my $use_ssl;
                   14883:     if ($ENV{'SERVER_PORT'} == 443) {
                   14884:         $use_ssl = 1;
                   14885:     }
1.1094    raeburn  14886:     my $captcha = Captcha::reCAPTCHA->new;
                   14887:     return $captcha->get_options_setter({theme => 'white'})."\n".
1.1153    raeburn  14888:            $captcha->get_html($pubkey,undef,$use_ssl).
1.1094    raeburn  14889:            &mt('If either word is hard to read, [_1] will replace them.',
1.1133    raeburn  14890:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1094    raeburn  14891:            '<br /><br />';
                   14892: }
                   14893: 
                   14894: sub check_recaptcha {
                   14895:     my ($privkey) = @_;
                   14896:     my $captcha_chk;
                   14897:     my $captcha = Captcha::reCAPTCHA->new;
                   14898:     my $captcha_result =
                   14899:         $captcha->check_answer(
                   14900:                                 $privkey,
                   14901:                                 $ENV{'REMOTE_ADDR'},
                   14902:                                 $env{'form.recaptcha_challenge_field'},
                   14903:                                 $env{'form.recaptcha_response_field'},
                   14904:                               );
                   14905:     if ($captcha_result->{is_valid}) {
                   14906:         $captcha_chk = 1;
                   14907:     }
                   14908:     return $captcha_chk;
                   14909: }
                   14910: 
1.41      ng       14911: =pod
                   14912: 
                   14913: =back
                   14914: 
1.112     bowersj2 14915: =cut
1.41      ng       14916: 
1.112     bowersj2 14917: 1;
                   14918: __END__;
1.41      ng       14919: 

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