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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1152  ! golterma    4: # $Id: loncommon.pm,v 1.1151 2013/08/28 14:00:00 raeburn Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.1108    raeburn    70: use Apache::lonuserutils();
1.1110    raeburn    71: use Apache::lonuserstate();
1.479     albertel   72: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    73: use DateTime::TimeZone;
1.687     raeburn    74: use DateTime::Locale::Catalog;
1.1091    foxr       75: use Text::Aspell;
1.1094    raeburn    76: use Authen::Captcha;
                     77: use Captcha::reCAPTCHA;
1.117     www        78: 
1.517     raeburn    79: # ---------------------------------------------- Designs
                     80: use vars qw(%defaultdesign);
                     81: 
1.22      www        82: my $readit;
                     83: 
1.517     raeburn    84: 
1.157     matthew    85: ##
                     86: ## Global Variables
                     87: ##
1.46      matthew    88: 
1.643     foxr       89: 
                     90: # ----------------------------------------------- SSI with retries:
                     91: #
                     92: 
                     93: =pod
                     94: 
1.648     raeburn    95: =head1 Server Side include with retries:
1.643     foxr       96: 
                     97: =over 4
                     98: 
1.648     raeburn    99: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      100: 
                    101: Performs an ssi with some number of retries.  Retries continue either
                    102: until the result is ok or until the retry count supplied by the
                    103: caller is exhausted.  
                    104: 
                    105: Inputs:
1.648     raeburn   106: 
                    107: =over 4
                    108: 
1.643     foxr      109: resource   - Identifies the resource to insert.
1.648     raeburn   110: 
1.643     foxr      111: retries    - Count of the number of retries allowed.
1.648     raeburn   112: 
1.643     foxr      113: form       - Hash that identifies the rendering options.
                    114: 
1.648     raeburn   115: =back
                    116: 
                    117: Returns:
                    118: 
                    119: =over 4
                    120: 
1.643     foxr      121: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   122: 
1.643     foxr      123: response   - The response from the last attempt (which may or may not have been successful.
                    124: 
1.648     raeburn   125: =back
                    126: 
                    127: =back
                    128: 
1.643     foxr      129: =cut
                    130: 
                    131: sub ssi_with_retries {
                    132:     my ($resource, $retries, %form) = @_;
                    133: 
                    134: 
                    135:     my $ok = 0;			# True if we got a good response.
                    136:     my $content;
                    137:     my $response;
                    138: 
                    139:     # Try to get the ssi done. within the retries count:
                    140: 
                    141:     do {
                    142: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    143: 	$ok      = $response->is_success;
1.650     www       144:         if (!$ok) {
                    145:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    146:         }
1.643     foxr      147: 	$retries--;
                    148:     } while (!$ok && ($retries > 0));
                    149: 
                    150:     if (!$ok) {
                    151: 	$content = '';		# On error return an empty content.
                    152:     }
                    153:     return ($content, $response);
                    154: 
                    155: }
                    156: 
                    157: 
                    158: 
1.20      www       159: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  160: my %language;
1.124     www       161: my %supported_language;
1.1088    foxr      162: my %supported_codes;
1.1048    foxr      163: my %latex_language;		# For choosing hyphenation in <transl..>
                    164: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  165: my %cprtag;
1.192     taceyjo1  166: my %scprtag;
1.351     www       167: my %fe; my %fd; my %fm;
1.41      ng        168: my %category_extensions;
1.12      harris41  169: 
1.46      matthew   170: # ---------------------------------------------- Thesaurus variables
1.144     matthew   171: #
                    172: # %Keywords:
                    173: #      A hash used by &keyword to determine if a word is considered a keyword.
                    174: # $thesaurus_db_file 
                    175: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   176: 
                    177: my %Keywords;
                    178: my $thesaurus_db_file;
                    179: 
1.144     matthew   180: #
                    181: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    182: # thesaurus.tab, and filecategories.tab.
                    183: #
1.18      www       184: BEGIN {
1.46      matthew   185:     # Variable initialization
                    186:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    187:     #
1.22      www       188:     unless ($readit) {
1.12      harris41  189: # ------------------------------------------------------------------- languages
                    190:     {
1.158     raeburn   191:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    192:                                    '/language.tab';
                    193:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  194:             while (my $line = <$fh>) {
                    195:                 next if ($line=~/^\#/);
                    196:                 chomp($line);
1.1088    foxr      197:                 my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   198:                 $language{$key}=$val.' - '.$enc;
                    199:                 if ($sup) {
                    200:                     $supported_language{$key}=$sup;
1.1088    foxr      201: 		    $supported_codes{$key}   = $code;
1.158     raeburn   202:                 }
1.1048    foxr      203: 		if ($latex) {
                    204: 		    $latex_language_bykey{$key} = $latex;
1.1088    foxr      205: 		    $latex_language{$code} = $latex;
1.1048    foxr      206: 		}
1.158     raeburn   207:             }
                    208:             close($fh);
                    209:         }
1.12      harris41  210:     }
                    211: # ------------------------------------------------------------------ copyrights
                    212:     {
1.158     raeburn   213:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    214:                                   '/copyright.tab';
                    215:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  216:             while (my $line = <$fh>) {
                    217:                 next if ($line=~/^\#/);
                    218:                 chomp($line);
                    219:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   220:                 $cprtag{$key}=$val;
                    221:             }
                    222:             close($fh);
                    223:         }
1.12      harris41  224:     }
1.351     www       225: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  226:     {
                    227:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    228:                                   '/source_copyright.tab';
                    229:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  230:             while (my $line = <$fh>) {
                    231:                 next if ($line =~ /^\#/);
                    232:                 chomp($line);
                    233:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  234:                 $scprtag{$key}=$val;
                    235:             }
                    236:             close($fh);
                    237:         }
                    238:     }
1.63      www       239: 
1.517     raeburn   240: # -------------------------------------------------------------- default domain designs
1.63      www       241:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   242:     my $designfile = $designdir.'/default.tab';
                    243:     if ( open (my $fh,"<$designfile") ) {
                    244:         while (my $line = <$fh>) {
                    245:             next if ($line =~ /^\#/);
                    246:             chomp($line);
                    247:             my ($key,$val)=(split(/\=/,$line));
                    248:             if ($val) { $defaultdesign{$key}=$val; }
                    249:         }
                    250:         close($fh);
1.63      www       251:     }
                    252: 
1.15      harris41  253: # ------------------------------------------------------------- file categories
                    254:     {
1.158     raeburn   255:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    256:                                   '/filecategories.tab';
                    257:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  258: 	    while (my $line = <$fh>) {
                    259: 		next if ($line =~ /^\#/);
                    260: 		chomp($line);
                    261:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   262:                 push @{$category_extensions{lc($category)}},$extension;
                    263:             }
                    264:             close($fh);
                    265:         }
                    266: 
1.15      harris41  267:     }
1.12      harris41  268: # ------------------------------------------------------------------ file types
                    269:     {
1.158     raeburn   270:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    271:                '/filetypes.tab';
                    272:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  273:             while (my $line = <$fh>) {
                    274: 		next if ($line =~ /^\#/);
                    275: 		chomp($line);
                    276:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   277:                 if ($descr ne '') {
                    278:                     $fe{$ending}=lc($emb);
                    279:                     $fd{$ending}=$descr;
1.351     www       280:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   281:                 }
                    282:             }
                    283:             close($fh);
                    284:         }
1.12      harris41  285:     }
1.22      www       286:     &Apache::lonnet::logthis(
1.705     tempelho  287:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       288:     $readit=1;
1.46      matthew   289:     }  # end of unless($readit) 
1.32      matthew   290:     
                    291: }
1.112     bowersj2  292: 
1.42      matthew   293: ###############################################################
                    294: ##           HTML and Javascript Helper Functions            ##
                    295: ###############################################################
                    296: 
                    297: =pod 
                    298: 
1.112     bowersj2  299: =head1 HTML and Javascript Functions
1.42      matthew   300: 
1.112     bowersj2  301: =over 4
                    302: 
1.648     raeburn   303: =item * &browser_and_searcher_javascript()
1.112     bowersj2  304: 
                    305: X<browsing, javascript>X<searching, javascript>Returns a string
                    306: containing javascript with two functions, C<openbrowser> and
                    307: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    308: tags.
1.42      matthew   309: 
1.648     raeburn   310: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   311: 
                    312: inputs: formname, elementname, only, omit
                    313: 
                    314: formname and elementname indicate the name of the html form and name of
                    315: the element that the results of the browsing selection are to be placed in. 
                    316: 
                    317: Specifying 'only' will restrict the browser to displaying only files
1.185     www       318: with the given extension.  Can be a comma separated list.
1.42      matthew   319: 
                    320: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       321: with the given extension.  Can be a comma separated list.
1.42      matthew   322: 
1.648     raeburn   323: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   324: 
                    325: Inputs: formname, elementname
                    326: 
                    327: formname and elementname specify the name of the html form and the name
                    328: of the element the selection from the search results will be placed in.
1.542     raeburn   329: 
1.42      matthew   330: =cut
                    331: 
                    332: sub browser_and_searcher_javascript {
1.199     albertel  333:     my ($mode)=@_;
                    334:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  335:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   336:     return <<END;
1.219     albertel  337: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   338:     var editbrowser = null;
1.135     albertel  339:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       340:         var url = '$resurl/?';
1.42      matthew   341:         if (editbrowser == null) {
                    342:             url += 'launch=1&';
                    343:         }
                    344:         url += 'catalogmode=interactive&';
1.199     albertel  345:         url += 'mode=$mode&';
1.611     albertel  346:         url += 'inhibitmenu=yes&';
1.42      matthew   347:         url += 'form=' + formname + '&';
                    348:         if (only != null) {
                    349:             url += 'only=' + only + '&';
1.217     albertel  350:         } else {
                    351:             url += 'only=&';
                    352: 	}
1.42      matthew   353:         if (omit != null) {
                    354:             url += 'omit=' + omit + '&';
1.217     albertel  355:         } else {
                    356:             url += 'omit=&';
                    357: 	}
1.135     albertel  358:         if (titleelement != null) {
                    359:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  360:         } else {
                    361: 	    url += 'titleelement=&';
                    362: 	}
1.42      matthew   363:         url += 'element=' + elementname + '';
                    364:         var title = 'Browser';
1.435     albertel  365:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   366:         options += ',width=700,height=600';
                    367:         editbrowser = open(url,title,options,'1');
                    368:         editbrowser.focus();
                    369:     }
                    370:     var editsearcher;
1.135     albertel  371:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   372:         var url = '/adm/searchcat?';
                    373:         if (editsearcher == null) {
                    374:             url += 'launch=1&';
                    375:         }
                    376:         url += 'catalogmode=interactive&';
1.199     albertel  377:         url += 'mode=$mode&';
1.42      matthew   378:         url += 'form=' + formname + '&';
1.135     albertel  379:         if (titleelement != null) {
                    380:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  381:         } else {
                    382: 	    url += 'titleelement=&';
                    383: 	}
1.42      matthew   384:         url += 'element=' + elementname + '';
                    385:         var title = 'Search';
1.435     albertel  386:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   387:         options += ',width=700,height=600';
                    388:         editsearcher = open(url,title,options,'1');
                    389:         editsearcher.focus();
                    390:     }
1.219     albertel  391: // END LON-CAPA Internal -->
1.42      matthew   392: END
1.170     www       393: }
                    394: 
                    395: sub lastresurl {
1.258     albertel  396:     if ($env{'environment.lastresurl'}) {
                    397: 	return $env{'environment.lastresurl'}
1.170     www       398:     } else {
                    399: 	return '/res';
                    400:     }
                    401: }
                    402: 
                    403: sub storeresurl {
                    404:     my $resurl=&Apache::lonnet::clutter(shift);
                    405:     unless ($resurl=~/^\/res/) { return 0; }
                    406:     $resurl=~s/\/$//;
                    407:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   408:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       409:     return 1;
1.42      matthew   410: }
                    411: 
1.74      www       412: sub studentbrowser_javascript {
1.111     www       413:    unless (
1.258     albertel  414:             (($env{'request.course.id'}) && 
1.302     albertel  415:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    416: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    417: 					  '/'.$env{'request.course.sec'})
                    418: 	      ))
1.258     albertel  419:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       420:           ) { return ''; }  
1.74      www       421:    return (<<'ENDSTDBRW');
1.776     bisitz    422: <script type="text/javascript" language="Javascript">
1.824     bisitz    423: // <![CDATA[
1.74      www       424:     var stdeditbrowser;
1.999     www       425:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       426:         var url = '/adm/pickstudent?';
                    427:         var filter;
1.558     albertel  428: 	if (!ignorefilter) {
                    429: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    430: 	}
1.74      www       431:         if (filter != null) {
                    432:            if (filter != '') {
                    433:                url += 'filter='+filter+'&';
                    434: 	   }
                    435:         }
                    436:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       437:                                     '&udomelement='+udom+
                    438:                                     '&clicker='+clicker;
1.111     www       439: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   440:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       441:         var title = 'Student_Browser';
1.74      www       442:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    443:         options += ',width=700,height=600';
                    444:         stdeditbrowser = open(url,title,options,'1');
                    445:         stdeditbrowser.focus();
                    446:     }
1.824     bisitz    447: // ]]>
1.74      www       448: </script>
                    449: ENDSTDBRW
                    450: }
1.42      matthew   451: 
1.1003    www       452: sub resourcebrowser_javascript {
                    453:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       454:    return (<<'ENDRESBRW');
1.1003    www       455: <script type="text/javascript" language="Javascript">
                    456: // <![CDATA[
                    457:     var reseditbrowser;
1.1004    www       458:     function openresbrowser(formname,reslink) {
1.1005    www       459:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       460:         var title = 'Resource_Browser';
                    461:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       462:         options += ',width=700,height=500';
1.1004    www       463:         reseditbrowser = open(url,title,options,'1');
                    464:         reseditbrowser.focus();
1.1003    www       465:     }
                    466: // ]]>
                    467: </script>
1.1004    www       468: ENDRESBRW
1.1003    www       469: }
                    470: 
1.74      www       471: sub selectstudent_link {
1.999     www       472:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    473:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    474:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    475:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  476:    if ($env{'request.course.id'}) {  
1.302     albertel  477:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    478: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    479: 					'/'.$env{'request.course.sec'})) {
1.111     www       480: 	   return '';
                    481:        }
1.999     www       482:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   483:        if ($courseadvonly)  {
                    484:            $callargs .= ",'',1,1";
                    485:        }
                    486:        return '<span class="LC_nobreak">'.
                    487:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    488:               &mt('Select User').'</a></span>';
1.74      www       489:    }
1.258     albertel  490:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       491:        $callargs .= ",'',1"; 
1.793     raeburn   492:        return '<span class="LC_nobreak">'.
                    493:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    494:               &mt('Select User').'</a></span>';
1.111     www       495:    }
                    496:    return '';
1.91      www       497: }
                    498: 
1.1004    www       499: sub selectresource_link {
                    500:    my ($form,$reslink,$arg)=@_;
                    501:    
                    502:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    503:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    504:    unless ($env{'request.course.id'}) { return $arg; }
                    505:    return '<span class="LC_nobreak">'.
                    506:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    507:               $arg.'</a></span>';
                    508: }
                    509: 
                    510: 
                    511: 
1.653     raeburn   512: sub authorbrowser_javascript {
                    513:     return <<"ENDAUTHORBRW";
1.776     bisitz    514: <script type="text/javascript" language="JavaScript">
1.824     bisitz    515: // <![CDATA[
1.653     raeburn   516: var stdeditbrowser;
                    517: 
                    518: function openauthorbrowser(formname,udom) {
                    519:     var url = '/adm/pickauthor?';
                    520:     url += 'form='+formname+'&roledom='+udom;
                    521:     var title = 'Author_Browser';
                    522:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    523:     options += ',width=700,height=600';
                    524:     stdeditbrowser = open(url,title,options,'1');
                    525:     stdeditbrowser.focus();
                    526: }
                    527: 
1.824     bisitz    528: // ]]>
1.653     raeburn   529: </script>
                    530: ENDAUTHORBRW
                    531: }
                    532: 
1.91      www       533: sub coursebrowser_javascript {
1.1116    raeburn   534:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
                    535:         $credits_element) = @_;
1.932     raeburn   536:     my $wintitle = 'Course_Browser';
1.931     raeburn   537:     if ($crstype eq 'Community') {
1.932     raeburn   538:         $wintitle = 'Community_Browser';
1.909     raeburn   539:     }
1.876     raeburn   540:     my $id_functions = &javascript_index_functions();
                    541:     my $output = '
1.776     bisitz    542: <script type="text/javascript" language="JavaScript">
1.824     bisitz    543: // <![CDATA[
1.468     raeburn   544:     var stdeditbrowser;'."\n";
1.876     raeburn   545: 
                    546:     $output .= <<"ENDSTDBRW";
1.909     raeburn   547:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       548:         var url = '/adm/pickcourse?';
1.895     raeburn   549:         var formid = getFormIdByName(formname);
1.876     raeburn   550:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  551:         if (domainfilter != null) {
                    552:            if (domainfilter != '') {
                    553:                url += 'domainfilter='+domainfilter+'&';
                    554: 	   }
                    555:         }
1.91      www       556:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  557: 	                            '&cdomelement='+udom+
                    558:                                     '&cnameelement='+desc;
1.468     raeburn   559:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   560:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   561:                 url += '&roleelement='+extra_element;
                    562:                 if (domainfilter == null || domainfilter == '') {
                    563:                     url += '&domainfilter='+extra_element;
                    564:                 }
1.234     raeburn   565:             }
1.468     raeburn   566:             else {
                    567:                 if (formname == 'portform') {
                    568:                     url += '&setroles='+extra_element;
1.800     raeburn   569:                 } else {
                    570:                     if (formname == 'rules') {
                    571:                         url += '&fixeddom='+extra_element; 
                    572:                     }
1.468     raeburn   573:                 }
                    574:             }     
1.230     raeburn   575:         }
1.909     raeburn   576:         if (type != null && type != '') {
                    577:             url += '&type='+type;
                    578:         }
                    579:         if (type_elem != null && type_elem != '') {
                    580:             url += '&typeelement='+type_elem;
                    581:         }
1.872     raeburn   582:         if (formname == 'ccrs') {
                    583:             var ownername = document.forms[formid].ccuname.value;
                    584:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    585:             url += '&cloner='+ownername+':'+ownerdom;
                    586:         }
1.293     raeburn   587:         if (multflag !=null && multflag != '') {
                    588:             url += '&multiple='+multflag;
                    589:         }
1.909     raeburn   590:         var title = '$wintitle';
1.91      www       591:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    592:         options += ',width=700,height=600';
                    593:         stdeditbrowser = open(url,title,options,'1');
                    594:         stdeditbrowser.focus();
                    595:     }
1.876     raeburn   596: $id_functions
                    597: ENDSTDBRW
1.1116    raeburn   598:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    599:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    600:                                       $credits_element);
1.876     raeburn   601:     }
                    602:     $output .= '
                    603: // ]]>
                    604: </script>';
                    605:     return $output;
                    606: }
                    607: 
                    608: sub javascript_index_functions {
                    609:     return <<"ENDJS";
                    610: 
                    611: function getFormIdByName(formname) {
                    612:     for (var i=0;i<document.forms.length;i++) {
                    613:         if (document.forms[i].name == formname) {
                    614:             return i;
                    615:         }
                    616:     }
                    617:     return -1;
                    618: }
                    619: 
                    620: function getIndexByName(formid,item) {
                    621:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    622:         if (document.forms[formid].elements[i].name == item) {
                    623:             return i;
                    624:         }
                    625:     }
                    626:     return -1;
                    627: }
1.468     raeburn   628: 
1.876     raeburn   629: function getDomainFromSelectbox(formname,udom) {
                    630:     var userdom;
                    631:     var formid = getFormIdByName(formname);
                    632:     if (formid > -1) {
                    633:         var domid = getIndexByName(formid,udom);
                    634:         if (domid > -1) {
                    635:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    636:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    637:             }
                    638:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    639:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   640:             }
                    641:         }
                    642:     }
1.876     raeburn   643:     return userdom;
                    644: }
                    645: 
                    646: ENDJS
1.468     raeburn   647: 
1.876     raeburn   648: }
                    649: 
1.1017    raeburn   650: sub javascript_array_indexof {
1.1018    raeburn   651:     return <<ENDJS;
1.1017    raeburn   652: <script type="text/javascript" language="JavaScript">
                    653: // <![CDATA[
                    654: 
                    655: if (!Array.prototype.indexOf) {
                    656:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    657:         "use strict";
                    658:         if (this === void 0 || this === null) {
                    659:             throw new TypeError();
                    660:         }
                    661:         var t = Object(this);
                    662:         var len = t.length >>> 0;
                    663:         if (len === 0) {
                    664:             return -1;
                    665:         }
                    666:         var n = 0;
                    667:         if (arguments.length > 0) {
                    668:             n = Number(arguments[1]);
1.1088    foxr      669:             if (n !== n) { // shortcut for verifying if it is NaN
1.1017    raeburn   670:                 n = 0;
                    671:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    672:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    673:             }
                    674:         }
                    675:         if (n >= len) {
                    676:             return -1;
                    677:         }
                    678:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    679:         for (; k < len; k++) {
                    680:             if (k in t && t[k] === searchElement) {
                    681:                 return k;
                    682:             }
                    683:         }
                    684:         return -1;
                    685:     }
                    686: }
                    687: 
                    688: // ]]>
                    689: </script>
                    690: 
                    691: ENDJS
                    692: 
                    693: }
                    694: 
1.876     raeburn   695: sub userbrowser_javascript {
                    696:     my $id_functions = &javascript_index_functions();
                    697:     return <<"ENDUSERBRW";
                    698: 
1.888     raeburn   699: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   700:     var url = '/adm/pickuser?';
                    701:     var userdom = getDomainFromSelectbox(formname,udom);
                    702:     if (userdom != null) {
                    703:        if (userdom != '') {
                    704:            url += 'srchdom='+userdom+'&';
                    705:        }
                    706:     }
                    707:     url += 'form=' + formname + '&unameelement='+uname+
                    708:                                 '&udomelement='+udom+
                    709:                                 '&ulastelement='+ulast+
                    710:                                 '&ufirstelement='+ufirst+
                    711:                                 '&uemailelement='+uemail+
1.881     raeburn   712:                                 '&hideudomelement='+hideudom+
                    713:                                 '&coursedom='+crsdom;
1.888     raeburn   714:     if ((caller != null) && (caller != undefined)) {
                    715:         url += '&caller='+caller;
                    716:     }
1.876     raeburn   717:     var title = 'User_Browser';
                    718:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    719:     options += ',width=700,height=600';
                    720:     var stdeditbrowser = open(url,title,options,'1');
                    721:     stdeditbrowser.focus();
                    722: }
                    723: 
1.888     raeburn   724: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   725:     var formid = getFormIdByName(formname);
                    726:     if (formid > -1) {
1.888     raeburn   727:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   728:         var domid = getIndexByName(formid,udom);
                    729:         var hidedomid = getIndexByName(formid,origdom);
                    730:         if (hidedomid > -1) {
                    731:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   732:             var unameval = document.forms[formid].elements[unameid].value;
                    733:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    734:                 if (domid > -1) {
                    735:                     var slct = document.forms[formid].elements[domid];
                    736:                     if (slct.type == 'select-one') {
                    737:                         var i;
                    738:                         for (i=0;i<slct.length;i++) {
                    739:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    740:                         }
                    741:                     }
                    742:                     if (slct.type == 'hidden') {
                    743:                         slct.value = fixeddom;
1.876     raeburn   744:                     }
                    745:                 }
1.468     raeburn   746:             }
                    747:         }
                    748:     }
1.876     raeburn   749:     return;
                    750: }
                    751: 
                    752: $id_functions
                    753: ENDUSERBRW
1.468     raeburn   754: }
                    755: 
                    756: sub setsec_javascript {
1.1116    raeburn   757:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   758:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    759:         $communityrolestr);
                    760:     if ($role_element ne '') {
                    761:         my @allroles = ('st','ta','ep','in','ad');
                    762:         foreach my $crstype ('Course','Community') {
                    763:             if ($crstype eq 'Community') {
                    764:                 foreach my $role (@allroles) {
                    765:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    766:                 }
                    767:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    768:             } else {
                    769:                 foreach my $role (@allroles) {
                    770:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    771:                 }
                    772:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    773:             }
                    774:         }
                    775:         $rolestr = '"'.join('","',@allroles).'"';
                    776:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    777:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    778:     }
1.468     raeburn   779:     my $setsections = qq|
                    780: function setSect(sectionlist) {
1.629     raeburn   781:     var sectionsArray = new Array();
                    782:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    783:         sectionsArray = sectionlist.split(",");
                    784:     }
1.468     raeburn   785:     var numSections = sectionsArray.length;
                    786:     document.$formname.$sec_element.length = 0;
                    787:     if (numSections == 0) {
                    788:         document.$formname.$sec_element.multiple=false;
                    789:         document.$formname.$sec_element.size=1;
                    790:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    791:     } else {
                    792:         if (numSections == 1) {
                    793:             document.$formname.$sec_element.multiple=false;
                    794:             document.$formname.$sec_element.size=1;
                    795:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    796:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    797:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    798:         } else {
                    799:             for (var i=0; i<numSections; i++) {
                    800:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    801:             }
                    802:             document.$formname.$sec_element.multiple=true
                    803:             if (numSections < 3) {
                    804:                 document.$formname.$sec_element.size=numSections;
                    805:             } else {
                    806:                 document.$formname.$sec_element.size=3;
                    807:             }
                    808:             document.$formname.$sec_element.options[0].selected = false
                    809:         }
                    810:     }
1.91      www       811: }
1.905     raeburn   812: 
                    813: function setRole(crstype) {
1.468     raeburn   814: |;
1.905     raeburn   815:     if ($role_element eq '') {
                    816:         $setsections .= '    return;
                    817: }
                    818: ';
                    819:     } else {
                    820:         $setsections .= qq|
                    821:     var elementLength = document.$formname.$role_element.length;
                    822:     var allroles = Array($rolestr);
                    823:     var courserolenames = Array($courserolestr);
                    824:     var communityrolenames = Array($communityrolestr);
                    825:     if (elementLength != undefined) {
                    826:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    827:             if (crstype == 'Course') {
                    828:                 return;
                    829:             } else {
                    830:                 allroles[5] = 'co';
                    831:                 for (var i=0; i<6; i++) {
                    832:                     document.$formname.$role_element.options[i].value = allroles[i];
                    833:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    834:                 }
                    835:             }
                    836:         } else {
                    837:             if (crstype == 'Community') {
                    838:                 return;
                    839:             } else {
                    840:                 allroles[5] = 'cc';
                    841:                 for (var i=0; i<6; i++) {
                    842:                     document.$formname.$role_element.options[i].value = allroles[i];
                    843:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    844:                 }
                    845:             }
                    846:         }
                    847:     }
                    848:     return;
                    849: }
                    850: |;
                    851:     }
1.1116    raeburn   852:     if ($credits_element) {
                    853:         $setsections .= qq|
                    854: function setCredits(defaultcredits) {
                    855:     document.$formname.$credits_element.value = defaultcredits;
                    856:     return;
                    857: }
                    858: |;
                    859:     }
1.468     raeburn   860:     return $setsections;
                    861: }
                    862: 
1.91      www       863: sub selectcourse_link {
1.909     raeburn   864:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    865:        $typeelement) = @_;
                    866:    my $type = $selecttype;
1.871     raeburn   867:    my $linktext = &mt('Select Course');
                    868:    if ($selecttype eq 'Community') {
1.909     raeburn   869:        $linktext = &mt('Select Community');
1.906     raeburn   870:    } elsif ($selecttype eq 'Course/Community') {
                    871:        $linktext = &mt('Select Course/Community');
1.909     raeburn   872:        $type = '';
1.1019    raeburn   873:    } elsif ($selecttype eq 'Select') {
                    874:        $linktext = &mt('Select');
                    875:        $type = '';
1.871     raeburn   876:    }
1.787     bisitz    877:    return '<span class="LC_nobreak">'
                    878:          ."<a href='"
                    879:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    880:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   881:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   882:          ."'>".$linktext.'</a>'
1.787     bisitz    883:          .'</span>';
1.74      www       884: }
1.42      matthew   885: 
1.653     raeburn   886: sub selectauthor_link {
                    887:    my ($form,$udom)=@_;
                    888:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    889:           &mt('Select Author').'</a>';
                    890: }
                    891: 
1.876     raeburn   892: sub selectuser_link {
1.881     raeburn   893:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   894:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   895:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   896:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   897:            ');">'.$linktext.'</a>';
1.876     raeburn   898: }
                    899: 
1.273     raeburn   900: sub check_uncheck_jscript {
                    901:     my $jscript = <<"ENDSCRT";
                    902: function checkAll(field) {
                    903:     if (field.length > 0) {
                    904:         for (i = 0; i < field.length; i++) {
1.1093    raeburn   905:             if (!field[i].disabled) { 
                    906:                 field[i].checked = true;
                    907:             }
1.273     raeburn   908:         }
                    909:     } else {
1.1093    raeburn   910:         if (!field.disabled) { 
                    911:             field.checked = true;
                    912:         }
1.273     raeburn   913:     }
                    914: }
                    915:  
                    916: function uncheckAll(field) {
                    917:     if (field.length > 0) {
                    918:         for (i = 0; i < field.length; i++) {
                    919:             field[i].checked = false ;
1.543     albertel  920:         }
                    921:     } else {
1.273     raeburn   922:         field.checked = false ;
                    923:     }
                    924: }
                    925: ENDSCRT
                    926:     return $jscript;
                    927: }
                    928: 
1.656     www       929: sub select_timezone {
1.659     raeburn   930:    my ($name,$selected,$onchange,$includeempty)=@_;
                    931:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    932:    if ($includeempty) {
                    933:        $output .= '<option value=""';
                    934:        if (($selected eq '') || ($selected eq 'local')) {
                    935:            $output .= ' selected="selected" ';
                    936:        }
                    937:        $output .= '> </option>';
                    938:    }
1.657     raeburn   939:    my @timezones = DateTime::TimeZone->all_names;
                    940:    foreach my $tzone (@timezones) {
                    941:        $output.= '<option value="'.$tzone.'"';
                    942:        if ($tzone eq $selected) {
                    943:            $output.=' selected="selected"';
                    944:        }
                    945:        $output.=">$tzone</option>\n";
1.656     www       946:    }
                    947:    $output.="</select>";
                    948:    return $output;
                    949: }
1.273     raeburn   950: 
1.687     raeburn   951: sub select_datelocale {
                    952:     my ($name,$selected,$onchange,$includeempty)=@_;
                    953:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    954:     if ($includeempty) {
                    955:         $output .= '<option value=""';
                    956:         if ($selected eq '') {
                    957:             $output .= ' selected="selected" ';
                    958:         }
                    959:         $output .= '> </option>';
                    960:     }
                    961:     my (@possibles,%locale_names);
                    962:     my @locales = DateTime::Locale::Catalog::Locales;
                    963:     foreach my $locale (@locales) {
                    964:         if (ref($locale) eq 'HASH') {
                    965:             my $id = $locale->{'id'};
                    966:             if ($id ne '') {
                    967:                 my $en_terr = $locale->{'en_territory'};
                    968:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   969:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   970:                 if (grep(/^en$/,@languages) || !@languages) {
                    971:                     if ($en_terr ne '') {
                    972:                         $locale_names{$id} = '('.$en_terr.')';
                    973:                     } elsif ($native_terr ne '') {
                    974:                         $locale_names{$id} = $native_terr;
                    975:                     }
                    976:                 } else {
                    977:                     if ($native_terr ne '') {
                    978:                         $locale_names{$id} = $native_terr.' ';
                    979:                     } elsif ($en_terr ne '') {
                    980:                         $locale_names{$id} = '('.$en_terr.')';
                    981:                     }
                    982:                 }
                    983:                 push (@possibles,$id);
                    984:             }
                    985:         }
                    986:     }
                    987:     foreach my $item (sort(@possibles)) {
                    988:         $output.= '<option value="'.$item.'"';
                    989:         if ($item eq $selected) {
                    990:             $output.=' selected="selected"';
                    991:         }
                    992:         $output.=">$item";
                    993:         if ($locale_names{$item} ne '') {
                    994:             $output.="  $locale_names{$item}</option>\n";
                    995:         }
                    996:         $output.="</option>\n";
                    997:     }
                    998:     $output.="</select>";
                    999:     return $output;
                   1000: }
                   1001: 
1.792     raeburn  1002: sub select_language {
                   1003:     my ($name,$selected,$includeempty) = @_;
                   1004:     my %langchoices;
                   1005:     if ($includeempty) {
1.1117    raeburn  1006:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1007:     }
                   1008:     foreach my $id (&languageids()) {
                   1009:         my $code = &supportedlanguagecode($id);
                   1010:         if ($code) {
                   1011:             $langchoices{$code} = &plainlanguagedescription($id);
                   1012:         }
                   1013:     }
1.1117    raeburn  1014:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970     raeburn  1015:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1016: }
                   1017: 
1.42      matthew  1018: =pod
1.36      matthew  1019: 
1.1088    foxr     1020: 
                   1021: =item * &list_languages()
                   1022: 
                   1023: Returns an array reference that is suitable for use in language prompters.
                   1024: Each array element is itself a two element array.  The first element
                   1025: is the language code.  The second element a descsriptiuon of the 
                   1026: language itself.  This is suitable for use in e.g.
                   1027: &Apache::edit::select_arg (once dereferenced that is).
                   1028: 
                   1029: =cut 
                   1030: 
                   1031: sub list_languages {
                   1032:     my @lang_choices;
                   1033: 
                   1034:     foreach my $id (&languageids()) {
                   1035: 	my $code = &supportedlanguagecode($id);
                   1036: 	if ($code) {
                   1037: 	    my $selector    = $supported_codes{$id};
                   1038: 	    my $description = &plainlanguagedescription($id);
                   1039: 	    push (@lang_choices, [$selector, $description]);
                   1040: 	}
                   1041:     }
                   1042:     return \@lang_choices;
                   1043: }
                   1044: 
                   1045: =pod
                   1046: 
1.648     raeburn  1047: =item * &linked_select_forms(...)
1.36      matthew  1048: 
                   1049: linked_select_forms returns a string containing a <script></script> block
                   1050: and html for two <select> menus.  The select menus will be linked in that
                   1051: changing the value of the first menu will result in new values being placed
                   1052: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1053: order unless a defined order is provided.
1.36      matthew  1054: 
                   1055: linked_select_forms takes the following ordered inputs:
                   1056: 
                   1057: =over 4
                   1058: 
1.112     bowersj2 1059: =item * $formname, the name of the <form> tag
1.36      matthew  1060: 
1.112     bowersj2 1061: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1062: 
1.112     bowersj2 1063: =item * $firstdefault, the default value for the first menu
1.36      matthew  1064: 
1.112     bowersj2 1065: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1066: 
1.112     bowersj2 1067: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1068: 
1.112     bowersj2 1069: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1070: 
1.609     raeburn  1071: =item * $menuorder, the order of values in the first menu
                   1072: 
1.1115    raeburn  1073: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1074:         event for the first <select> tag
                   1075: 
                   1076: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1077:         event for the second <select> tag
                   1078: 
1.41      ng       1079: =back 
                   1080: 
1.36      matthew  1081: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1082: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1083: values for the first select menu.  The text that coincides with the 
1.41      ng       1084: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1085: and text for the second menu are given in the hash pointed to by 
                   1086: $menu{$choice1}->{'select2'}.  
                   1087: 
1.112     bowersj2 1088:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1089:                        default => "B3",
                   1090:                        select2 => { 
                   1091:                            B1 => "Choice B1",
                   1092:                            B2 => "Choice B2",
                   1093:                            B3 => "Choice B3",
                   1094:                            B4 => "Choice B4"
1.609     raeburn  1095:                            },
                   1096:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1097:                    },
                   1098:                A2 => { text =>"Choice A2" ,
                   1099:                        default => "C2",
                   1100:                        select2 => { 
                   1101:                            C1 => "Choice C1",
                   1102:                            C2 => "Choice C2",
                   1103:                            C3 => "Choice C3"
1.609     raeburn  1104:                            },
                   1105:                        order => ['C2','C1','C3'],
1.112     bowersj2 1106:                    },
                   1107:                A3 => { text =>"Choice A3" ,
                   1108:                        default => "D6",
                   1109:                        select2 => { 
                   1110:                            D1 => "Choice D1",
                   1111:                            D2 => "Choice D2",
                   1112:                            D3 => "Choice D3",
                   1113:                            D4 => "Choice D4",
                   1114:                            D5 => "Choice D5",
                   1115:                            D6 => "Choice D6",
                   1116:                            D7 => "Choice D7"
1.609     raeburn  1117:                            },
                   1118:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1119:                    }
                   1120:                );
1.36      matthew  1121: 
                   1122: =cut
                   1123: 
                   1124: sub linked_select_forms {
                   1125:     my ($formname,
                   1126:         $middletext,
                   1127:         $firstdefault,
                   1128:         $firstselectname,
                   1129:         $secondselectname, 
1.609     raeburn  1130:         $hashref,
                   1131:         $menuorder,
1.1115    raeburn  1132:         $onchangefirst,
                   1133:         $onchangesecond
1.36      matthew  1134:         ) = @_;
                   1135:     my $second = "document.$formname.$secondselectname";
                   1136:     my $first = "document.$formname.$firstselectname";
                   1137:     # output the javascript to do the changing
                   1138:     my $result = '';
1.776     bisitz   1139:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1140:     $result.="// <![CDATA[\n";
1.36      matthew  1141:     $result.="var select2data = new Object();\n";
                   1142:     $" = '","';
                   1143:     my $debug = '';
                   1144:     foreach my $s1 (sort(keys(%$hashref))) {
                   1145:         $result.="select2data.d_$s1 = new Object();\n";        
                   1146:         $result.="select2data.d_$s1.def = new String('".
                   1147:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1148:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1149:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1150:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1151:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1152:         }
1.36      matthew  1153:         $result.="\"@s2values\");\n";
                   1154:         $result.="select2data.d_$s1.texts = new Array(";        
                   1155:         my @s2texts;
                   1156:         foreach my $value (@s2values) {
                   1157:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1158:         }
                   1159:         $result.="\"@s2texts\");\n";
                   1160:     }
                   1161:     $"=' ';
                   1162:     $result.= <<"END";
                   1163: 
                   1164: function select1_changed() {
                   1165:     // Determine new choice
                   1166:     var newvalue = "d_" + $first.value;
                   1167:     // update select2
                   1168:     var values     = select2data[newvalue].values;
                   1169:     var texts      = select2data[newvalue].texts;
                   1170:     var select2def = select2data[newvalue].def;
                   1171:     var i;
                   1172:     // out with the old
                   1173:     for (i = 0; i < $second.options.length; i++) {
                   1174:         $second.options[i] = null;
                   1175:     }
                   1176:     // in with the nuclear
                   1177:     for (i=0;i<values.length; i++) {
                   1178:         $second.options[i] = new Option(values[i]);
1.143     matthew  1179:         $second.options[i].value = values[i];
1.36      matthew  1180:         $second.options[i].text = texts[i];
                   1181:         if (values[i] == select2def) {
                   1182:             $second.options[i].selected = true;
                   1183:         }
                   1184:     }
                   1185: }
1.824     bisitz   1186: // ]]>
1.36      matthew  1187: </script>
                   1188: END
                   1189:     # output the initial values for the selection lists
1.1115    raeburn  1190:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1191:     my @order = sort(keys(%{$hashref}));
                   1192:     if (ref($menuorder) eq 'ARRAY') {
                   1193:         @order = @{$menuorder};
                   1194:     }
                   1195:     foreach my $value (@order) {
1.36      matthew  1196:         $result.="    <option value=\"$value\" ";
1.253     albertel 1197:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1198:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1199:     }
                   1200:     $result .= "</select>\n";
                   1201:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1202:     $result .= $middletext;
1.1115    raeburn  1203:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1204:     if ($onchangesecond) {
                   1205:         $result .= ' onchange="'.$onchangesecond.'"';
                   1206:     }
                   1207:     $result .= ">\n";
1.36      matthew  1208:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1209:     
                   1210:     my @secondorder = sort(keys(%select2));
                   1211:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1212:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1213:     }
                   1214:     foreach my $value (@secondorder) {
1.36      matthew  1215:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1216:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1217:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1218:     }
                   1219:     $result .= "</select>\n";
                   1220:     #    return $debug;
                   1221:     return $result;
                   1222: }   #  end of sub linked_select_forms {
                   1223: 
1.45      matthew  1224: =pod
1.44      bowersj2 1225: 
1.973     raeburn  1226: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1227: 
1.112     bowersj2 1228: Returns a string corresponding to an HTML link to the given help
                   1229: $topic, where $topic corresponds to the name of a .tex file in
                   1230: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1231: spaces. 
                   1232: 
                   1233: $text will optionally be linked to the same topic, allowing you to
                   1234: link text in addition to the graphic. If you do not want to link
                   1235: text, but wish to specify one of the later parameters, pass an
                   1236: empty string. 
                   1237: 
                   1238: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1239: the link will not open a new window. If false, the link will open
                   1240: a new window using Javascript. (Default is false.) 
                   1241: 
                   1242: $width and $height are optional numerical parameters that will
                   1243: override the width and height of the popped up window, which may
1.973     raeburn  1244: be useful for certain help topics with big pictures included.
                   1245: 
                   1246: $imgid is the id of the img tag used for the help icon. This may be
                   1247: used in a javascript call to switch the image src.  See 
                   1248: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1249: 
                   1250: =cut
                   1251: 
                   1252: sub help_open_topic {
1.973     raeburn  1253:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1254:     $text = "" if (not defined $text);
1.44      bowersj2 1255:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1256:     $width = 500 if (not defined $width);
1.44      bowersj2 1257:     $height = 400 if (not defined $height);
                   1258:     my $filename = $topic;
                   1259:     $filename =~ s/ /_/g;
                   1260: 
1.48      bowersj2 1261:     my $template = "";
                   1262:     my $link;
1.572     banghart 1263:     
1.159     www      1264:     $topic=~s/\W/\_/g;
1.44      bowersj2 1265: 
1.572     banghart 1266:     if (!$stayOnPage) {
1.1033    www      1267: 	$link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037    www      1268:     } elsif ($stayOnPage eq 'popup') {
                   1269:         $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1.572     banghart 1270:     } else {
1.48      bowersj2 1271: 	$link = "/adm/help/${filename}.hlp";
                   1272:     }
                   1273: 
                   1274:     # Add the text
1.755     neumanie 1275:     if ($text ne "") {	
1.763     bisitz   1276: 	$template.='<span class="LC_help_open_topic">'
                   1277:                   .'<a target="_top" href="'.$link.'">'
                   1278:                   .$text.'</a>';
1.48      bowersj2 1279:     }
                   1280: 
1.763     bisitz   1281:     # (Always) Add the graphic
1.179     matthew  1282:     my $title = &mt('Online Help');
1.667     raeburn  1283:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1284:     if ($imgid ne '') {
                   1285:         $imgid = ' id="'.$imgid.'"';
                   1286:     }
1.763     bisitz   1287:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1288:               .'<img src="'.$helpicon.'" border="0"'
                   1289:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1290:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1291:               .' /></a>';
                   1292:     if ($text ne "") {	
                   1293:         $template.='</span>';
                   1294:     }
1.44      bowersj2 1295:     return $template;
                   1296: 
1.106     bowersj2 1297: }
                   1298: 
                   1299: # This is a quicky function for Latex cheatsheet editing, since it 
                   1300: # appears in at least four places
                   1301: sub helpLatexCheatsheet {
1.1037    www      1302:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1303:     my $out;
1.106     bowersj2 1304:     my $addOther = '';
1.732     raeburn  1305:     if ($topic) {
1.1037    www      1306: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1307:     }
                   1308:     $out = '<span>' # Start cheatsheet
                   1309: 	  .$addOther
                   1310:           .'<span>'
1.1037    www      1311: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1312: 	  .'</span> <span>'
1.1037    www      1313: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1314: 	  .'</span>';
1.732     raeburn  1315:     unless ($not_author) {
1.763     bisitz   1316:         $out .= ' <span>'
1.1037    www      1317: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763     bisitz   1318: 	       .'</span>';
1.732     raeburn  1319:     }
1.763     bisitz   1320:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1321:     return $out;
1.172     www      1322: }
                   1323: 
1.430     albertel 1324: sub general_help {
                   1325:     my $helptopic='Student_Intro';
                   1326:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1327: 	$helptopic='Authoring_Intro';
1.907     raeburn  1328:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1329: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1330:     } elsif ($env{'request.role'}=~/^dc/) {
                   1331:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1332:     }
                   1333:     return $helptopic;
                   1334: }
                   1335: 
                   1336: sub update_help_link {
                   1337:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1338:     my $origurl = $ENV{'REQUEST_URI'};
                   1339:     $origurl=~s|^/~|/priv/|;
                   1340:     my $timestamp = time;
                   1341:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1342:         $$datum = &escape($$datum);
                   1343:     }
                   1344: 
                   1345:     my $banner_link = "/adm/helpmenu?page=banner&amp;topic=$topic&amp;component_help=$component_help&amp;faq=$faq&amp;bug=$bug&amp;origurl=$origurl&amp;stamp=$timestamp&amp;stayonpage=$stayOnPage";
                   1346:     my $output .= <<"ENDOUTPUT";
                   1347: <script type="text/javascript">
1.824     bisitz   1348: // <![CDATA[
1.430     albertel 1349: banner_link = '$banner_link';
1.824     bisitz   1350: // ]]>
1.430     albertel 1351: </script>
                   1352: ENDOUTPUT
                   1353:     return $output;
                   1354: }
                   1355: 
                   1356: # now just updates the help link and generates a blue icon
1.193     raeburn  1357: sub help_open_menu {
1.430     albertel 1358:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1359: 	= @_;    
1.949     droeschl 1360:     $stayOnPage = 1;
1.430     albertel 1361:     my $output;
                   1362:     if ($component_help) {
                   1363: 	if (!$text) {
                   1364: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1365: 				       $width,$height);
                   1366: 	} else {
                   1367: 	    my $help_text;
                   1368: 	    $help_text=&unescape($topic);
                   1369: 	    $output='<table><tr><td>'.
                   1370: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1371: 				 $width,$height).'</td></tr></table>';
                   1372: 	}
                   1373:     }
                   1374:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1375:     return $output.$banner_link;
                   1376: }
                   1377: 
                   1378: sub top_nav_help {
                   1379:     my ($text) = @_;
1.436     albertel 1380:     $text = &mt($text);
1.949     droeschl 1381:     my $stay_on_page = 1;
                   1382: 
1.572     banghart 1383:     my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1.436     albertel 1384: 	                     : "javascript:helpMenu('open')";
1.572     banghart 1385:     my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1.436     albertel 1386: 
1.201     raeburn  1387:     my $title = &mt('Get help');
1.436     albertel 1388: 
                   1389:     return <<"END";
                   1390: $banner_link
                   1391:  <a href="$link" title="$title">$text</a>
                   1392: END
                   1393: }
                   1394: 
                   1395: sub help_menu_js {
                   1396:     my ($text) = @_;
1.949     droeschl 1397:     my $stayOnPage = 1;
1.436     albertel 1398:     my $width = 620;
                   1399:     my $height = 600;
1.430     albertel 1400:     my $helptopic=&general_help();
                   1401:     my $details_link = '/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1402:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1403:     my $start_page =
                   1404:         &Apache::loncommon::start_page('Help Menu', undef,
                   1405: 				       {'frameset'    => 1,
                   1406: 					'js_ready'    => 1,
                   1407: 					'add_entries' => {
                   1408: 					    'border' => '0',
1.579     raeburn  1409: 					    'rows'   => "110,*",},});
1.331     albertel 1410:     my $end_page =
                   1411:         &Apache::loncommon::end_page({'frameset' => 1,
                   1412: 				      'js_ready' => 1,});
                   1413: 
1.436     albertel 1414:     my $template .= <<"ENDTEMPLATE";
                   1415: <script type="text/javascript">
1.877     bisitz   1416: // <![CDATA[
1.253     albertel 1417: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1418: var banner_link = '';
1.243     raeburn  1419: function helpMenu(target) {
                   1420:     var caller = this;
                   1421:     if (target == 'open') {
                   1422:         var newWindow = null;
                   1423:         try {
1.262     albertel 1424:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1425:         }
                   1426:         catch(error) {
                   1427:             writeHelp(caller);
                   1428:             return;
                   1429:         }
                   1430:         if (newWindow) {
                   1431:             caller = newWindow;
                   1432:         }
1.193     raeburn  1433:     }
1.243     raeburn  1434:     writeHelp(caller);
                   1435:     return;
                   1436: }
                   1437: function writeHelp(caller) {
1.1072    raeburn  1438:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" />\\n<frame name="bodyframe" src="$details_link" />\\n$end_page')
1.243     raeburn  1439:     caller.document.close()
                   1440:     caller.focus()
1.193     raeburn  1441: }
1.877     bisitz   1442: // END LON-CAPA Internal -->
1.253     albertel 1443: // ]]>
1.436     albertel 1444: </script>
1.193     raeburn  1445: ENDTEMPLATE
                   1446:     return $template;
                   1447: }
                   1448: 
1.172     www      1449: sub help_open_bug {
                   1450:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1451:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1452:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1453:     $text = "" if (not defined $text);
                   1454: 	$stayOnPage=1;
1.184     albertel 1455:     $width = 600 if (not defined $width);
                   1456:     $height = 600 if (not defined $height);
1.172     www      1457: 
                   1458:     $topic=~s/\W+/\+/g;
                   1459:     my $link='';
                   1460:     my $template='';
1.379     albertel 1461:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1462: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1463:     if (!$stayOnPage)
                   1464:     {
                   1465: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1466:     }
                   1467:     else
                   1468:     {
                   1469: 	$link = $url;
                   1470:     }
                   1471:     # Add the text
                   1472:     if ($text ne "")
                   1473:     {
                   1474: 	$template .= 
                   1475:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1476:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1477:     }
                   1478: 
                   1479:     # Add the graphic
1.179     matthew  1480:     my $title = &mt('Report a Bug');
1.215     albertel 1481:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1482:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1483:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1484: ENDTEMPLATE
                   1485:     if ($text ne '') { $template.='</td></tr></table>' };
                   1486:     return $template;
                   1487: 
                   1488: }
                   1489: 
                   1490: sub help_open_faq {
                   1491:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1492:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1493:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1494:     $text = "" if (not defined $text);
                   1495: 	$stayOnPage=1;
                   1496:     $width = 350 if (not defined $width);
                   1497:     $height = 400 if (not defined $height);
                   1498: 
                   1499:     $topic=~s/\W+/\+/g;
                   1500:     my $link='';
                   1501:     my $template='';
                   1502:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1503:     if (!$stayOnPage)
                   1504:     {
                   1505: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1506:     }
                   1507:     else
                   1508:     {
                   1509: 	$link = $url;
                   1510:     }
                   1511: 
                   1512:     # Add the text
                   1513:     if ($text ne "")
                   1514:     {
                   1515: 	$template .= 
1.173     www      1516:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1517:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1518:     }
                   1519: 
                   1520:     # Add the graphic
1.179     matthew  1521:     my $title = &mt('View the FAQ');
1.215     albertel 1522:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1523:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1524:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1525: ENDTEMPLATE
                   1526:     if ($text ne '') { $template.='</td></tr></table>' };
                   1527:     return $template;
                   1528: 
1.44      bowersj2 1529: }
1.37      matthew  1530: 
1.180     matthew  1531: ###############################################################
                   1532: ###############################################################
                   1533: 
1.45      matthew  1534: =pod
                   1535: 
1.648     raeburn  1536: =item * &change_content_javascript():
1.256     matthew  1537: 
                   1538: This and the next function allow you to create small sections of an
                   1539: otherwise static HTML page that you can update on the fly with
                   1540: Javascript, even in Netscape 4.
                   1541: 
                   1542: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1543: must be written to the HTML page once. It will prove the Javascript
                   1544: function "change(name, content)". Calling the change function with the
                   1545: name of the section 
                   1546: you want to update, matching the name passed to C<changable_area>, and
                   1547: the new content you want to put in there, will put the content into
                   1548: that area.
                   1549: 
                   1550: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1551: to contain room for the original contents. You need to "make space"
                   1552: for whatever changes you wish to make, and be B<sure> to check your
                   1553: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1554: it's adequate for updating a one-line status display, but little more.
                   1555: This script will set the space to 100% width, so you only need to
                   1556: worry about height in Netscape 4.
                   1557: 
                   1558: Modern browsers are much less limiting, and if you can commit to the
                   1559: user not using Netscape 4, this feature may be used freely with
                   1560: pretty much any HTML.
                   1561: 
                   1562: =cut
                   1563: 
                   1564: sub change_content_javascript {
                   1565:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1566:     if ($env{'browser.type'} eq 'netscape' &&
                   1567: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1568: 	return (<<NETSCAPE4);
                   1569: 	function change(name, content) {
                   1570: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1571: 	    doc.open();
                   1572: 	    doc.write(content);
                   1573: 	    doc.close();
                   1574: 	}
                   1575: NETSCAPE4
                   1576:     } else {
                   1577: 	# Otherwise, we need to use semi-standards-compliant code
                   1578: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1579: 	# is really scary, and every useful browser supports it
                   1580: 	return (<<DOMBASED);
                   1581: 	function change(name, content) {
                   1582: 	    element = document.getElementById(name);
                   1583: 	    element.innerHTML = content;
                   1584: 	}
                   1585: DOMBASED
                   1586:     }
                   1587: }
                   1588: 
                   1589: =pod
                   1590: 
1.648     raeburn  1591: =item * &changable_area($name,$origContent):
1.256     matthew  1592: 
                   1593: This provides a "changable area" that can be modified on the fly via
                   1594: the Javascript code provided in C<change_content_javascript>. $name is
                   1595: the name you will use to reference the area later; do not repeat the
                   1596: same name on a given HTML page more then once. $origContent is what
                   1597: the area will originally contain, which can be left blank.
                   1598: 
                   1599: =cut
                   1600: 
                   1601: sub changable_area {
                   1602:     my ($name, $origContent) = @_;
                   1603: 
1.258     albertel 1604:     if ($env{'browser.type'} eq 'netscape' &&
                   1605: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1606: 	# If this is netscape 4, we need to use the Layer tag
                   1607: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1608:     } else {
                   1609: 	return "<span id='$name'>$origContent</span>";
                   1610:     }
                   1611: }
                   1612: 
                   1613: =pod
                   1614: 
1.648     raeburn  1615: =item * &viewport_geometry_js 
1.590     raeburn  1616: 
                   1617: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1618: 
                   1619: =cut
                   1620: 
                   1621: 
                   1622: sub viewport_geometry_js { 
                   1623:     return <<"GEOMETRY";
                   1624: var Geometry = {};
                   1625: function init_geometry() {
                   1626:     if (Geometry.init) { return };
                   1627:     Geometry.init=1;
                   1628:     if (window.innerHeight) {
                   1629:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1630:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1631:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1632:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1633:     }
                   1634:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1635:         Geometry.getViewportHeight =
                   1636:             function() { return document.documentElement.clientHeight; };
                   1637:         Geometry.getViewportWidth =
                   1638:             function() { return document.documentElement.clientWidth; };
                   1639: 
                   1640:         Geometry.getHorizontalScroll =
                   1641:             function() { return document.documentElement.scrollLeft; };
                   1642:         Geometry.getVerticalScroll =
                   1643:             function() { return document.documentElement.scrollTop; };
                   1644:     }
                   1645:     else if (document.body.clientHeight) {
                   1646:         Geometry.getViewportHeight =
                   1647:             function() { return document.body.clientHeight; };
                   1648:         Geometry.getViewportWidth =
                   1649:             function() { return document.body.clientWidth; };
                   1650:         Geometry.getHorizontalScroll =
                   1651:             function() { return document.body.scrollLeft; };
                   1652:         Geometry.getVerticalScroll =
                   1653:             function() { return document.body.scrollTop; };
                   1654:     }
                   1655: }
                   1656: 
                   1657: GEOMETRY
                   1658: }
                   1659: 
                   1660: =pod
                   1661: 
1.648     raeburn  1662: =item * &viewport_size_js()
1.590     raeburn  1663: 
                   1664: Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window. 
                   1665: 
                   1666: =cut
                   1667: 
                   1668: sub viewport_size_js {
                   1669:     my $geometry = &viewport_geometry_js();
                   1670:     return <<"DIMS";
                   1671: 
                   1672: $geometry
                   1673: 
                   1674: function getViewportDims(width,height) {
                   1675:     init_geometry();
                   1676:     width.value = Geometry.getViewportWidth();
                   1677:     height.value = Geometry.getViewportHeight();
                   1678:     return;
                   1679: }
                   1680: 
                   1681: DIMS
                   1682: }
                   1683: 
                   1684: =pod
                   1685: 
1.648     raeburn  1686: =item * &resize_textarea_js()
1.565     albertel 1687: 
                   1688: emits the needed javascript to resize a textarea to be as big as possible
                   1689: 
                   1690: creates a function resize_textrea that takes two IDs first should be
                   1691: the id of the element to resize, second should be the id of a div that
                   1692: surrounds everything that comes after the textarea, this routine needs
                   1693: to be attached to the <body> for the onload and onresize events.
                   1694: 
1.648     raeburn  1695: =back
1.565     albertel 1696: 
                   1697: =cut
                   1698: 
                   1699: sub resize_textarea_js {
1.590     raeburn  1700:     my $geometry = &viewport_geometry_js();
1.565     albertel 1701:     return <<"RESIZE";
                   1702:     <script type="text/javascript">
1.824     bisitz   1703: // <![CDATA[
1.590     raeburn  1704: $geometry
1.565     albertel 1705: 
1.588     albertel 1706: function getX(element) {
                   1707:     var x = 0;
                   1708:     while (element) {
                   1709: 	x += element.offsetLeft;
                   1710: 	element = element.offsetParent;
                   1711:     }
                   1712:     return x;
                   1713: }
                   1714: function getY(element) {
                   1715:     var y = 0;
                   1716:     while (element) {
                   1717: 	y += element.offsetTop;
                   1718: 	element = element.offsetParent;
                   1719:     }
                   1720:     return y;
                   1721: }
                   1722: 
                   1723: 
1.565     albertel 1724: function resize_textarea(textarea_id,bottom_id) {
                   1725:     init_geometry();
                   1726:     var textarea        = document.getElementById(textarea_id);
                   1727:     //alert(textarea);
                   1728: 
1.588     albertel 1729:     var textarea_top    = getY(textarea);
1.565     albertel 1730:     var textarea_height = textarea.offsetHeight;
                   1731:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1732:     var bottom_top      = getY(bottom);
1.565     albertel 1733:     var bottom_height   = bottom.offsetHeight;
                   1734:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1735:     var fudge           = 23;
1.565     albertel 1736:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1737:     if (new_height < 300) {
                   1738: 	new_height = 300;
                   1739:     }
                   1740:     textarea.style.height=new_height+'px';
                   1741: }
1.824     bisitz   1742: // ]]>
1.565     albertel 1743: </script>
                   1744: RESIZE
                   1745: 
                   1746: }
                   1747: 
                   1748: =pod
                   1749: 
1.256     matthew  1750: =head1 Excel and CSV file utility routines
                   1751: 
                   1752: =over 4
                   1753: 
                   1754: =cut
                   1755: 
                   1756: ###############################################################
                   1757: ###############################################################
                   1758: 
                   1759: =pod
                   1760: 
1.648     raeburn  1761: =item * &csv_translate($text) 
1.37      matthew  1762: 
1.185     www      1763: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1764: format.
                   1765: 
                   1766: =cut
                   1767: 
1.180     matthew  1768: ###############################################################
                   1769: ###############################################################
1.37      matthew  1770: sub csv_translate {
                   1771:     my $text = shift;
                   1772:     $text =~ s/\"/\"\"/g;
1.209     albertel 1773:     $text =~ s/\n/ /g;
1.37      matthew  1774:     return $text;
                   1775: }
1.180     matthew  1776: 
                   1777: ###############################################################
                   1778: ###############################################################
                   1779: 
                   1780: =pod
                   1781: 
1.648     raeburn  1782: =item * &define_excel_formats()
1.180     matthew  1783: 
                   1784: Define some commonly used Excel cell formats.
                   1785: 
                   1786: Currently supported formats:
                   1787: 
                   1788: =over 4
                   1789: 
                   1790: =item header
                   1791: 
                   1792: =item bold
                   1793: 
                   1794: =item h1
                   1795: 
                   1796: =item h2
                   1797: 
                   1798: =item h3
                   1799: 
1.256     matthew  1800: =item h4
                   1801: 
                   1802: =item i
                   1803: 
1.180     matthew  1804: =item date
                   1805: 
                   1806: =back
                   1807: 
                   1808: Inputs: $workbook
                   1809: 
                   1810: Returns: $format, a hash reference.
                   1811: 
1.1057    foxr     1812: 
1.180     matthew  1813: =cut
                   1814: 
                   1815: ###############################################################
                   1816: ###############################################################
                   1817: sub define_excel_formats {
                   1818:     my ($workbook) = @_;
                   1819:     my $format;
                   1820:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1821:                                                 bottom    => 1,
                   1822:                                                 align     => 'center');
                   1823:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1824:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1825:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1826:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1827:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1828:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1829:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1830:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1831:     return $format;
                   1832: }
                   1833: 
                   1834: ###############################################################
                   1835: ###############################################################
1.113     bowersj2 1836: 
                   1837: =pod
                   1838: 
1.648     raeburn  1839: =item * &create_workbook()
1.255     matthew  1840: 
                   1841: Create an Excel worksheet.  If it fails, output message on the
                   1842: request object and return undefs.
                   1843: 
                   1844: Inputs: Apache request object
                   1845: 
                   1846: Returns (undef) on failure, 
                   1847:     Excel worksheet object, scalar with filename, and formats 
                   1848:     from &Apache::loncommon::define_excel_formats on success
                   1849: 
                   1850: =cut
                   1851: 
                   1852: ###############################################################
                   1853: ###############################################################
                   1854: sub create_workbook {
                   1855:     my ($r) = @_;
                   1856:         #
                   1857:     # Create the excel spreadsheet
                   1858:     my $filename = '/prtspool/'.
1.258     albertel 1859:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1860:         time.'_'.rand(1000000000).'.xls';
                   1861:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1862:     if (! defined($workbook)) {
                   1863:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1864:         $r->print(
                   1865:             '<p class="LC_error">'
                   1866:            .&mt('Problems occurred in creating the new Excel file.')
                   1867:            .' '.&mt('This error has been logged.')
                   1868:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1869:            .'</p>'
                   1870:         );
1.255     matthew  1871:         return (undef);
                   1872:     }
                   1873:     #
1.1014    foxr     1874:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1875:     #
                   1876:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1877:     return ($workbook,$filename,$format);
                   1878: }
                   1879: 
                   1880: ###############################################################
                   1881: ###############################################################
                   1882: 
                   1883: =pod
                   1884: 
1.648     raeburn  1885: =item * &create_text_file()
1.113     bowersj2 1886: 
1.542     raeburn  1887: Create a file to write to and eventually make available to the user.
1.256     matthew  1888: If file creation fails, outputs an error message on the request object and 
                   1889: return undefs.
1.113     bowersj2 1890: 
1.256     matthew  1891: Inputs: Apache request object, and file suffix
1.113     bowersj2 1892: 
1.256     matthew  1893: Returns (undef) on failure, 
                   1894:     Filehandle and filename on success.
1.113     bowersj2 1895: 
                   1896: =cut
                   1897: 
1.256     matthew  1898: ###############################################################
                   1899: ###############################################################
                   1900: sub create_text_file {
                   1901:     my ($r,$suffix) = @_;
                   1902:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1903:     my $fh;
                   1904:     my $filename = '/prtspool/'.
1.258     albertel 1905:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1906:         time.'_'.rand(1000000000).'.'.$suffix;
                   1907:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1908:     if (! defined($fh)) {
                   1909:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1910:         $r->print(
                   1911:             '<p class="LC_error">'
                   1912:            .&mt('Problems occurred in creating the output file.')
                   1913:            .' '.&mt('This error has been logged.')
                   1914:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1915:            .'</p>'
                   1916:         );
1.113     bowersj2 1917:     }
1.256     matthew  1918:     return ($fh,$filename)
1.113     bowersj2 1919: }
                   1920: 
                   1921: 
1.256     matthew  1922: =pod 
1.113     bowersj2 1923: 
                   1924: =back
                   1925: 
                   1926: =cut
1.37      matthew  1927: 
                   1928: ###############################################################
1.33      matthew  1929: ##        Home server <option> list generating code          ##
                   1930: ###############################################################
1.35      matthew  1931: 
1.169     www      1932: # ------------------------------------------
                   1933: 
                   1934: sub domain_select {
                   1935:     my ($name,$value,$multiple)=@_;
                   1936:     my %domains=map { 
1.514     albertel 1937: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1938:     } &Apache::lonnet::all_domains();
1.169     www      1939:     if ($multiple) {
                   1940: 	$domains{''}=&mt('Any domain');
1.550     albertel 1941: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1942: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1943:     } else {
1.550     albertel 1944: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1945: 	return &select_form($name,$value,\%domains);
1.169     www      1946:     }
                   1947: }
                   1948: 
1.282     albertel 1949: #-------------------------------------------
                   1950: 
                   1951: =pod
                   1952: 
1.519     raeburn  1953: =head1 Routines for form select boxes
                   1954: 
                   1955: =over 4
                   1956: 
1.648     raeburn  1957: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1958: 
                   1959: Returns a string containing a <select> element int multiple mode
                   1960: 
                   1961: 
                   1962: Args:
                   1963:   $name - name of the <select> element
1.506     raeburn  1964:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1965:   $size - number of rows long the select element is
1.283     albertel 1966:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1967:           (shown text should already have been &mt())
1.506     raeburn  1968:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1969: 
1.282     albertel 1970: =cut
                   1971: 
                   1972: #-------------------------------------------
1.169     www      1973: sub multiple_select_form {
1.284     albertel 1974:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1975:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1976:     my $output='';
1.191     matthew  1977:     if (! defined($size)) {
                   1978:         $size = 4;
1.283     albertel 1979:         if (scalar(keys(%$hash))<4) {
                   1980:             $size = scalar(keys(%$hash));
1.191     matthew  1981:         }
                   1982:     }
1.734     bisitz   1983:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1984:     my @order;
1.506     raeburn  1985:     if (ref($order) eq 'ARRAY')  {
                   1986:         @order = @{$order};
                   1987:     } else {
                   1988:         @order = sort(keys(%$hash));
1.501     banghart 1989:     }
                   1990:     if (exists($$hash{'select_form_order'})) {
                   1991:         @order = @{$$hash{'select_form_order'}};
                   1992:     }
                   1993:         
1.284     albertel 1994:     foreach my $key (@order) {
1.356     albertel 1995:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1996:         $output.='selected="selected" ' if ($selected{$key});
                   1997:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1998:     }
                   1999:     $output.="</select>\n";
                   2000:     return $output;
                   2001: }
                   2002: 
1.88      www      2003: #-------------------------------------------
                   2004: 
                   2005: =pod
                   2006: 
1.970     raeburn  2007: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      2008: 
                   2009: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  2010: allow a user to select options from a ref to a hash containing:
                   2011: option_name => displayed text. An optional $onchange can include
                   2012: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   2013: 
1.88      www      2014: See lonrights.pm for an example invocation and use.
                   2015: 
                   2016: =cut
                   2017: 
                   2018: #-------------------------------------------
                   2019: sub select_form {
1.970     raeburn  2020:     my ($def,$name,$hashref,$onchange) = @_;
                   2021:     return unless (ref($hashref) eq 'HASH');
                   2022:     if ($onchange) {
                   2023:         $onchange = ' onchange="'.$onchange.'"';
                   2024:     }
                   2025:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 2026:     my @keys;
1.970     raeburn  2027:     if (exists($hashref->{'select_form_order'})) {
                   2028: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2029:     } else {
1.970     raeburn  2030: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2031:     }
1.356     albertel 2032:     foreach my $key (@keys) {
                   2033:         $selectform.=
                   2034: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2035:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2036:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2037:     }
                   2038:     $selectform.="</select>";
                   2039:     return $selectform;
                   2040: }
                   2041: 
1.475     www      2042: # For display filters
                   2043: 
                   2044: sub display_filter {
1.1074    raeburn  2045:     my ($context) = @_;
1.475     www      2046:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2047:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2048:     my $phraseinput = 'hidden';
                   2049:     my $includeinput = 'hidden';
                   2050:     my ($checked,$includetypestext);
                   2051:     if ($env{'form.displayfilter'} eq 'containing') {
                   2052:         $phraseinput = 'text'; 
                   2053:         if ($context eq 'parmslog') {
                   2054:             $includeinput = 'checkbox';
                   2055:             if ($env{'form.includetypes'}) {
                   2056:                 $checked = ' checked="checked"';
                   2057:             }
                   2058:             $includetypestext = &mt('Include parameter types');
                   2059:         }
                   2060:     } else {
                   2061:         $includetypestext = '&nbsp;';
                   2062:     }
                   2063:     my ($additional,$secondid,$thirdid);
                   2064:     if ($context eq 'parmslog') {
                   2065:         $additional = 
                   2066:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2067:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2068:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2069:             '</label>';
                   2070:         $secondid = 'includetypes';
                   2071:         $thirdid = 'includetypestext';
                   2072:     }
                   2073:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2074:                                                     '$secondid','$thirdid')";
                   2075:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2076: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2077: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2078: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2079:            &mt('Filter: [_1]',
1.477     www      2080: 	   &select_form($env{'form.displayfilter'},
                   2081: 			'displayfilter',
1.970     raeburn  2082: 			{'currentfolder' => 'Current folder/page',
1.477     www      2083: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2084: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2085: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2086:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2087:                          '" />'.$additional;
                   2088: }
                   2089: 
                   2090: sub display_filter_js {
                   2091:     my $includetext = &mt('Include parameter types');
                   2092:     return <<"ENDJS";
                   2093:   
                   2094: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2095:     var firstType = 'hidden';
                   2096:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2097:         firstType = 'text';
                   2098:     }
                   2099:     firstObject = document.getElementById(firstid);
                   2100:     if (typeof(firstObject) == 'object') {
                   2101:         if (firstObject.type != firstType) {
                   2102:             changeInputType(firstObject,firstType);
                   2103:         }
                   2104:     }
                   2105:     if (context == 'parmslog') {
                   2106:         var secondType = 'hidden';
                   2107:         if (firstType == 'text') {
                   2108:             secondType = 'checkbox';
                   2109:         }
                   2110:         secondObject = document.getElementById(secondid);  
                   2111:         if (typeof(secondObject) == 'object') {
                   2112:             if (secondObject.type != secondType) {
                   2113:                 changeInputType(secondObject,secondType);
                   2114:             }
                   2115:         }
                   2116:         var textItem = document.getElementById(thirdid);
                   2117:         var currtext = textItem.innerHTML;
                   2118:         var newtext;
                   2119:         if (firstType == 'text') {
                   2120:             newtext = '$includetext';
                   2121:         } else {
                   2122:             newtext = '&nbsp;';
                   2123:         }
                   2124:         if (currtext != newtext) {
                   2125:             textItem.innerHTML = newtext;
                   2126:         }
                   2127:     }
                   2128:     return;
                   2129: }
                   2130: 
                   2131: function changeInputType(oldObject,newType) {
                   2132:     var newObject = document.createElement('input');
                   2133:     newObject.type = newType;
                   2134:     if (oldObject.size) {
                   2135:         newObject.size = oldObject.size;
                   2136:     }
                   2137:     if (oldObject.value) {
                   2138:         newObject.value = oldObject.value;
                   2139:     }
                   2140:     if (oldObject.name) {
                   2141:         newObject.name = oldObject.name;
                   2142:     }
                   2143:     if (oldObject.id) {
                   2144:         newObject.id = oldObject.id;
                   2145:     }
                   2146:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2147:     return;
                   2148: }
                   2149: 
                   2150: ENDJS
1.475     www      2151: }
                   2152: 
1.167     www      2153: sub gradeleveldescription {
                   2154:     my $gradelevel=shift;
                   2155:     my %gradelevels=(0 => 'Not specified',
                   2156: 		     1 => 'Grade 1',
                   2157: 		     2 => 'Grade 2',
                   2158: 		     3 => 'Grade 3',
                   2159: 		     4 => 'Grade 4',
                   2160: 		     5 => 'Grade 5',
                   2161: 		     6 => 'Grade 6',
                   2162: 		     7 => 'Grade 7',
                   2163: 		     8 => 'Grade 8',
                   2164: 		     9 => 'Grade 9',
                   2165: 		     10 => 'Grade 10',
                   2166: 		     11 => 'Grade 11',
                   2167: 		     12 => 'Grade 12',
                   2168: 		     13 => 'Grade 13',
                   2169: 		     14 => '100 Level',
                   2170: 		     15 => '200 Level',
                   2171: 		     16 => '300 Level',
                   2172: 		     17 => '400 Level',
                   2173: 		     18 => 'Graduate Level');
                   2174:     return &mt($gradelevels{$gradelevel});
                   2175: }
                   2176: 
1.163     www      2177: sub select_level_form {
                   2178:     my ($deflevel,$name)=@_;
                   2179:     unless ($deflevel) { $deflevel=0; }
1.167     www      2180:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2181:     for (my $i=0; $i<=18; $i++) {
                   2182:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2183:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2184:                 ">".&gradeleveldescription($i)."</option>\n";
                   2185:     }
                   2186:     $selectform.="</select>";
                   2187:     return $selectform;
1.163     www      2188: }
1.167     www      2189: 
1.35      matthew  2190: #-------------------------------------------
                   2191: 
1.45      matthew  2192: =pod
                   2193: 
1.1121    raeburn  2194: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2195: 
                   2196: Returns a string containing a <select name='$name' size='1'> form to 
                   2197: allow a user to select the domain to preform an operation in.  
                   2198: See loncreateuser.pm for an example invocation and use.
                   2199: 
1.90      www      2200: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2201: selected");
                   2202: 
1.743     raeburn  2203: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2204: 
1.910     raeburn  2205: The optional $onchange argument specifies what should occur if the domain selector is changed, e.g., 'this.form.submit()' if the form is to be automatically submitted.
                   2206: 
1.1121    raeburn  2207: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2208: 
                   2209: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563     raeburn  2210: 
1.35      matthew  2211: =cut
                   2212: 
                   2213: #-------------------------------------------
1.34      matthew  2214: sub select_dom_form {
1.1121    raeburn  2215:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2216:     if ($onchange) {
1.874     raeburn  2217:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2218:     }
1.1121    raeburn  2219:     my (@domains,%exclude);
1.910     raeburn  2220:     if (ref($incdoms) eq 'ARRAY') {
                   2221:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2222:     } else {
                   2223:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2224:     }
1.90      www      2225:     if ($includeempty) { @domains=('',@domains); }
1.1121    raeburn  2226:     if (ref($excdoms) eq 'ARRAY') {
                   2227:         map { $exclude{$_} = 1; } @{$excdoms}; 
                   2228:     }
1.743     raeburn  2229:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2230:     foreach my $dom (@domains) {
1.1121    raeburn  2231:         next if ($exclude{$dom});
1.356     albertel 2232:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2233:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2234:         if ($showdomdesc) {
                   2235:             if ($dom ne '') {
                   2236:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2237:                 if ($domdesc ne '') {
                   2238:                     $selectdomain .= ' ('.$domdesc.')';
                   2239:                 }
                   2240:             } 
                   2241:         }
                   2242:         $selectdomain .= "</option>\n";
1.34      matthew  2243:     }
                   2244:     $selectdomain.="</select>";
                   2245:     return $selectdomain;
                   2246: }
                   2247: 
1.35      matthew  2248: #-------------------------------------------
                   2249: 
1.45      matthew  2250: =pod
                   2251: 
1.648     raeburn  2252: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2253: 
1.586     raeburn  2254: input: 4 arguments (two required, two optional) - 
                   2255:     $domain - domain of new user
                   2256:     $name - name of form element
                   2257:     $default - Value of 'default' causes a default item to be first 
                   2258:                             option, and selected by default. 
                   2259:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2260:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2261: output: returns 2 items: 
1.586     raeburn  2262: (a) form element which contains either:
                   2263:    (i) <select name="$name">
                   2264:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2265:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2266:        </select>
                   2267:        form item if there are multiple library servers in $domain, or
                   2268:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2269:        if there is only one library server in $domain.
                   2270: 
                   2271: (b) number of library servers found.
                   2272: 
                   2273: See loncreateuser.pm for example of use.
1.35      matthew  2274: 
                   2275: =cut
                   2276: 
                   2277: #-------------------------------------------
1.586     raeburn  2278: sub home_server_form_item {
                   2279:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2280:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2281:     my $result;
                   2282:     my $numlib = keys(%servers);
                   2283:     if ($numlib > 1) {
                   2284:         $result .= '<select name="'.$name.'" />'."\n";
                   2285:         if ($default) {
1.804     bisitz   2286:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2287:                        '</option>'."\n";
                   2288:         }
                   2289:         foreach my $hostid (sort(keys(%servers))) {
                   2290:             $result.= '<option value="'.$hostid.'">'.
                   2291: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2292:         }
                   2293:         $result .= '</select>'."\n";
                   2294:     } elsif ($numlib == 1) {
                   2295:         my $hostid;
                   2296:         foreach my $item (keys(%servers)) {
                   2297:             $hostid = $item;
                   2298:         }
                   2299:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2300:                    $hostid.'" />';
                   2301:                    if (!$hide) {
                   2302:                        $result .= $hostid.' '.$servers{$hostid};
                   2303:                    }
                   2304:                    $result .= "\n";
                   2305:     } elsif ($default) {
                   2306:         $result .= '<input type="hidden" name="'.$name.
                   2307:                    '" value="default" />';
                   2308:                    if (!$hide) {
                   2309:                        $result .= &mt('default');
                   2310:                    }
                   2311:                    $result .= "\n";
1.33      matthew  2312:     }
1.586     raeburn  2313:     return ($result,$numlib);
1.33      matthew  2314: }
1.112     bowersj2 2315: 
                   2316: =pod
                   2317: 
1.534     albertel 2318: =back 
                   2319: 
1.112     bowersj2 2320: =cut
1.87      matthew  2321: 
                   2322: ###############################################################
1.112     bowersj2 2323: ##                  Decoding User Agent                      ##
1.87      matthew  2324: ###############################################################
                   2325: 
                   2326: =pod
                   2327: 
1.112     bowersj2 2328: =head1 Decoding the User Agent
                   2329: 
                   2330: =over 4
                   2331: 
                   2332: =item * &decode_user_agent()
1.87      matthew  2333: 
                   2334: Inputs: $r
                   2335: 
                   2336: Outputs:
                   2337: 
                   2338: =over 4
                   2339: 
1.112     bowersj2 2340: =item * $httpbrowser
1.87      matthew  2341: 
1.112     bowersj2 2342: =item * $clientbrowser
1.87      matthew  2343: 
1.112     bowersj2 2344: =item * $clientversion
1.87      matthew  2345: 
1.112     bowersj2 2346: =item * $clientmathml
1.87      matthew  2347: 
1.112     bowersj2 2348: =item * $clientunicode
1.87      matthew  2349: 
1.112     bowersj2 2350: =item * $clientos
1.87      matthew  2351: 
1.1137    raeburn  2352: =item * $clientmobile
                   2353: 
1.1141    raeburn  2354: =item * $clientinfo
                   2355: 
1.87      matthew  2356: =back
                   2357: 
1.157     matthew  2358: =back 
                   2359: 
1.87      matthew  2360: =cut
                   2361: 
                   2362: ###############################################################
                   2363: ###############################################################
                   2364: sub decode_user_agent {
1.247     albertel 2365:     my ($r)=@_;
1.87      matthew  2366:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2367:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2368:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2369:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2370:     my $clientbrowser='unknown';
                   2371:     my $clientversion='0';
                   2372:     my $clientmathml='';
                   2373:     my $clientunicode='0';
1.1137    raeburn  2374:     my $clientmobile=0;
1.87      matthew  2375:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2376:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2377: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2378: 	    $clientbrowser=$bname;
                   2379:             $httpbrowser=~/$vreg/i;
                   2380: 	    $clientversion=$1;
                   2381:             $clientmathml=($clientversion>=$minv);
                   2382:             $clientunicode=($clientversion>=$univ);
                   2383: 	}
                   2384:     }
                   2385:     my $clientos='unknown';
1.1141    raeburn  2386:     my $clientinfo;
1.87      matthew  2387:     if (($httpbrowser=~/linux/i) ||
                   2388:         ($httpbrowser=~/unix/i) ||
                   2389:         ($httpbrowser=~/ux/i) ||
                   2390:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2391:     if (($httpbrowser=~/vax/i) ||
                   2392:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2393:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2394:     if (($httpbrowser=~/mac/i) ||
                   2395:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2396:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2397:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137    raeburn  2398:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2399:         $clientmobile=lc($1);
                   2400:     }
1.1141    raeburn  2401:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2402:         $clientinfo = 'firefox-'.$1;
                   2403:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2404:         $clientinfo = 'chromeframe-'.$1;
                   2405:     }
1.87      matthew  2406:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1141    raeburn  2407:             $clientunicode,$clientos,$clientmobile,$clientinfo);
1.87      matthew  2408: }
                   2409: 
1.32      matthew  2410: ###############################################################
                   2411: ##    Authentication changing form generation subroutines    ##
                   2412: ###############################################################
                   2413: ##
                   2414: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2415: ## hash, and have reasonable default values.
                   2416: ##
                   2417: ##    formname = the name given in the <form> tag.
1.35      matthew  2418: #-------------------------------------------
                   2419: 
1.45      matthew  2420: =pod
                   2421: 
1.112     bowersj2 2422: =head1 Authentication Routines
                   2423: 
                   2424: =over 4
                   2425: 
1.648     raeburn  2426: =item * &authform_xxxxxx()
1.35      matthew  2427: 
                   2428: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2429: handle some of the conveniences required for authentication forms.  
                   2430: This is not an optimal method, but it works.  
                   2431: 
                   2432: =over 4
                   2433: 
1.112     bowersj2 2434: =item * authform_header
1.35      matthew  2435: 
1.112     bowersj2 2436: =item * authform_authorwarning
1.35      matthew  2437: 
1.112     bowersj2 2438: =item * authform_nochange
1.35      matthew  2439: 
1.112     bowersj2 2440: =item * authform_kerberos
1.35      matthew  2441: 
1.112     bowersj2 2442: =item * authform_internal
1.35      matthew  2443: 
1.112     bowersj2 2444: =item * authform_filesystem
1.35      matthew  2445: 
                   2446: =back
                   2447: 
1.648     raeburn  2448: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2449: 
1.35      matthew  2450: =cut
                   2451: 
                   2452: #-------------------------------------------
1.32      matthew  2453: sub authform_header{  
                   2454:     my %in = (
                   2455:         formname => 'cu',
1.80      albertel 2456:         kerb_def_dom => '',
1.32      matthew  2457:         @_,
                   2458:     );
                   2459:     $in{'formname'} = 'document.' . $in{'formname'};
                   2460:     my $result='';
1.80      albertel 2461: 
                   2462: #---------------------------------------------- Code for upper case translation
                   2463:     my $Javascript_toUpperCase;
                   2464:     unless ($in{kerb_def_dom}) {
                   2465:         $Javascript_toUpperCase =<<"END";
                   2466:         switch (choice) {
                   2467:            case 'krb': currentform.elements[choicearg].value =
                   2468:                currentform.elements[choicearg].value.toUpperCase();
                   2469:                break;
                   2470:            default:
                   2471:         }
                   2472: END
                   2473:     } else {
                   2474:         $Javascript_toUpperCase = "";
                   2475:     }
                   2476: 
1.165     raeburn  2477:     my $radioval = "'nochange'";
1.591     raeburn  2478:     if (defined($in{'curr_authtype'})) {
                   2479:         if ($in{'curr_authtype'} ne '') {
                   2480:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2481:         }
1.174     matthew  2482:     }
1.165     raeburn  2483:     my $argfield = 'null';
1.591     raeburn  2484:     if (defined($in{'mode'})) {
1.165     raeburn  2485:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2486:             if (defined($in{'curr_autharg'})) {
                   2487:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2488:                     $argfield = "'$in{'curr_autharg'}'";
                   2489:                 }
                   2490:             }
                   2491:         }
                   2492:     }
                   2493: 
1.32      matthew  2494:     $result.=<<"END";
                   2495: var current = new Object();
1.165     raeburn  2496: current.radiovalue = $radioval;
                   2497: current.argfield = $argfield;
1.32      matthew  2498: 
                   2499: function changed_radio(choice,currentform) {
                   2500:     var choicearg = choice + 'arg';
                   2501:     // If a radio button in changed, we need to change the argfield
                   2502:     if (current.radiovalue != choice) {
                   2503:         current.radiovalue = choice;
                   2504:         if (current.argfield != null) {
                   2505:             currentform.elements[current.argfield].value = '';
                   2506:         }
                   2507:         if (choice == 'nochange') {
                   2508:             current.argfield = null;
                   2509:         } else {
                   2510:             current.argfield = choicearg;
                   2511:             switch(choice) {
                   2512:                 case 'krb': 
                   2513:                     currentform.elements[current.argfield].value = 
                   2514:                         "$in{'kerb_def_dom'}";
                   2515:                 break;
                   2516:               default:
                   2517:                 break;
                   2518:             }
                   2519:         }
                   2520:     }
                   2521:     return;
                   2522: }
1.22      www      2523: 
1.32      matthew  2524: function changed_text(choice,currentform) {
                   2525:     var choicearg = choice + 'arg';
                   2526:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2527:         $Javascript_toUpperCase
1.32      matthew  2528:         // clear old field
                   2529:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2530:             currentform.elements[current.argfield].value = '';
                   2531:         }
                   2532:         current.argfield = choicearg;
                   2533:     }
                   2534:     set_auth_radio_buttons(choice,currentform);
                   2535:     return;
1.20      www      2536: }
1.32      matthew  2537: 
                   2538: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2539:     var numauthchoices = currentform.login.length;
                   2540:     if (typeof numauthchoices  == "undefined") {
                   2541:         return;
                   2542:     } 
1.32      matthew  2543:     var i=0;
1.986     raeburn  2544:     while (i < numauthchoices) {
1.32      matthew  2545:         if (currentform.login[i].value == newvalue) { break; }
                   2546:         i++;
                   2547:     }
1.986     raeburn  2548:     if (i == numauthchoices) {
1.32      matthew  2549:         return;
                   2550:     }
                   2551:     current.radiovalue = newvalue;
                   2552:     currentform.login[i].checked = true;
                   2553:     return;
                   2554: }
                   2555: END
                   2556:     return $result;
                   2557: }
                   2558: 
1.1106    raeburn  2559: sub authform_authorwarning {
1.32      matthew  2560:     my $result='';
1.144     matthew  2561:     $result='<i>'.
                   2562:         &mt('As a general rule, only authors or co-authors should be '.
                   2563:             'filesystem authenticated '.
                   2564:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2565:     return $result;
                   2566: }
                   2567: 
1.1106    raeburn  2568: sub authform_nochange {
1.32      matthew  2569:     my %in = (
                   2570:               formname => 'document.cu',
                   2571:               kerb_def_dom => 'MSU.EDU',
                   2572:               @_,
                   2573:           );
1.1106    raeburn  2574:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586     raeburn  2575:     my $result;
1.1104    raeburn  2576:     if (!$authnum) {
1.1105    raeburn  2577:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2578:     } else {
                   2579:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2580:                   '<input type="radio" name="login" value="nochange" '.
                   2581:                   'checked="checked" onclick="'.
1.281     albertel 2582:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2583: 	    '</label>';
1.586     raeburn  2584:     }
1.32      matthew  2585:     return $result;
                   2586: }
                   2587: 
1.591     raeburn  2588: sub authform_kerberos {
1.32      matthew  2589:     my %in = (
                   2590:               formname => 'document.cu',
                   2591:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2592:               kerb_def_auth => 'krb4',
1.32      matthew  2593:               @_,
                   2594:               );
1.586     raeburn  2595:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2596:         $autharg,$jscall);
1.1106    raeburn  2597:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2598:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2599:        $check5 = ' checked="checked"';
1.80      albertel 2600:     } else {
1.772     bisitz   2601:        $check4 = ' checked="checked"';
1.80      albertel 2602:     }
1.165     raeburn  2603:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2604:     if (defined($in{'curr_authtype'})) {
                   2605:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2606:             $krbcheck = ' checked="checked"';
1.623     raeburn  2607:             if (defined($in{'mode'})) {
                   2608:                 if ($in{'mode'} eq 'modifyuser') {
                   2609:                     $krbcheck = '';
                   2610:                 }
                   2611:             }
1.591     raeburn  2612:             if (defined($in{'curr_kerb_ver'})) {
                   2613:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2614:                     $check5 = ' checked="checked"';
1.591     raeburn  2615:                     $check4 = '';
                   2616:                 } else {
1.772     bisitz   2617:                     $check4 = ' checked="checked"';
1.591     raeburn  2618:                     $check5 = '';
                   2619:                 }
1.586     raeburn  2620:             }
1.591     raeburn  2621:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2622:                 $krbarg = $in{'curr_autharg'};
                   2623:             }
1.586     raeburn  2624:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2625:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2626:                     $result = 
                   2627:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2628:         $in{'curr_autharg'},$krbver);
                   2629:                 } else {
                   2630:                     $result =
                   2631:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2632:                 }
                   2633:                 return $result; 
                   2634:             }
                   2635:         }
                   2636:     } else {
                   2637:         if ($authnum == 1) {
1.784     bisitz   2638:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2639:         }
                   2640:     }
1.586     raeburn  2641:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2642:         return;
1.587     raeburn  2643:     } elsif ($authtype eq '') {
1.591     raeburn  2644:         if (defined($in{'mode'})) {
1.587     raeburn  2645:             if ($in{'mode'} eq 'modifycourse') {
                   2646:                 if ($authnum == 1) {
1.1104    raeburn  2647:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2648:                 }
                   2649:             }
                   2650:         }
1.586     raeburn  2651:     }
                   2652:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2653:     if ($authtype eq '') {
                   2654:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2655:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2656:                     $krbcheck.' />';
                   2657:     }
                   2658:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106    raeburn  2659:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2660:          $in{'curr_authtype'} eq 'krb5') ||
1.1106    raeburn  2661:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2662:          $in{'curr_authtype'} eq 'krb4')) {
                   2663:         $result .= &mt
1.144     matthew  2664:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2665:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2666:          '<label>'.$authtype,
1.281     albertel 2667:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2668:              'value="'.$krbarg.'" '.
1.144     matthew  2669:              'onchange="'.$jscall.'" />',
1.281     albertel 2670:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2671:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2672: 	 '</label>');
1.586     raeburn  2673:     } elsif ($can_assign{'krb4'}) {
                   2674:         $result .= &mt
                   2675:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2676:          '[_3] Version 4 [_4]',
                   2677:          '<label>'.$authtype,
                   2678:          '</label><input type="text" size="10" name="krbarg" '.
                   2679:              'value="'.$krbarg.'" '.
                   2680:              'onchange="'.$jscall.'" />',
                   2681:          '<label><input type="hidden" name="krbver" value="4" />',
                   2682:          '</label>');
                   2683:     } elsif ($can_assign{'krb5'}) {
                   2684:         $result .= &mt
                   2685:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2686:          '[_3] Version 5 [_4]',
                   2687:          '<label>'.$authtype,
                   2688:          '</label><input type="text" size="10" name="krbarg" '.
                   2689:              'value="'.$krbarg.'" '.
                   2690:              'onchange="'.$jscall.'" />',
                   2691:          '<label><input type="hidden" name="krbver" value="5" />',
                   2692:          '</label>');
                   2693:     }
1.32      matthew  2694:     return $result;
                   2695: }
                   2696: 
1.1106    raeburn  2697: sub authform_internal {
1.586     raeburn  2698:     my %in = (
1.32      matthew  2699:                 formname => 'document.cu',
                   2700:                 kerb_def_dom => 'MSU.EDU',
                   2701:                 @_,
                   2702:                 );
1.586     raeburn  2703:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2704:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2705:     if (defined($in{'curr_authtype'})) {
                   2706:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2707:             if ($can_assign{'int'}) {
1.772     bisitz   2708:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2709:                 if (defined($in{'mode'})) {
                   2710:                     if ($in{'mode'} eq 'modifyuser') {
                   2711:                         $intcheck = '';
                   2712:                     }
                   2713:                 }
1.591     raeburn  2714:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2715:                     $intarg = $in{'curr_autharg'};
                   2716:                 }
                   2717:             } else {
                   2718:                 $result = &mt('Currently internally authenticated.');
                   2719:                 return $result;
1.165     raeburn  2720:             }
                   2721:         }
1.586     raeburn  2722:     } else {
                   2723:         if ($authnum == 1) {
1.784     bisitz   2724:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2725:         }
                   2726:     }
                   2727:     if (!$can_assign{'int'}) {
                   2728:         return;
1.587     raeburn  2729:     } elsif ($authtype eq '') {
1.591     raeburn  2730:         if (defined($in{'mode'})) {
1.587     raeburn  2731:             if ($in{'mode'} eq 'modifycourse') {
                   2732:                 if ($authnum == 1) {
1.1104    raeburn  2733:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2734:                 }
                   2735:             }
                   2736:         }
1.165     raeburn  2737:     }
1.586     raeburn  2738:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2739:     if ($authtype eq '') {
                   2740:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2741:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2742:     }
1.605     bisitz   2743:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2744:                $intarg.'" onchange="'.$jscall.'" />';
                   2745:     $result = &mt
1.144     matthew  2746:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2747:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2748:     $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32      matthew  2749:     return $result;
                   2750: }
                   2751: 
1.1104    raeburn  2752: sub authform_local {
1.32      matthew  2753:     my %in = (
                   2754:               formname => 'document.cu',
                   2755:               kerb_def_dom => 'MSU.EDU',
                   2756:               @_,
                   2757:               );
1.586     raeburn  2758:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2759:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2760:     if (defined($in{'curr_authtype'})) {
                   2761:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2762:             if ($can_assign{'loc'}) {
1.772     bisitz   2763:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2764:                 if (defined($in{'mode'})) {
                   2765:                     if ($in{'mode'} eq 'modifyuser') {
                   2766:                         $loccheck = '';
                   2767:                     }
                   2768:                 }
1.591     raeburn  2769:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2770:                     $locarg = $in{'curr_autharg'};
                   2771:                 }
                   2772:             } else {
                   2773:                 $result = &mt('Currently using local (institutional) authentication.');
                   2774:                 return $result;
1.165     raeburn  2775:             }
                   2776:         }
1.586     raeburn  2777:     } else {
                   2778:         if ($authnum == 1) {
1.784     bisitz   2779:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2780:         }
                   2781:     }
                   2782:     if (!$can_assign{'loc'}) {
                   2783:         return;
1.587     raeburn  2784:     } elsif ($authtype eq '') {
1.591     raeburn  2785:         if (defined($in{'mode'})) {
1.587     raeburn  2786:             if ($in{'mode'} eq 'modifycourse') {
                   2787:                 if ($authnum == 1) {
1.1104    raeburn  2788:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2789:                 }
                   2790:             }
                   2791:         }
1.165     raeburn  2792:     }
1.586     raeburn  2793:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2794:     if ($authtype eq '') {
                   2795:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2796:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2797:                     $jscall.'" />';
                   2798:     }
                   2799:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2800:                $locarg.'" onchange="'.$jscall.'" />';
                   2801:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2802:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2803:     return $result;
                   2804: }
                   2805: 
1.1106    raeburn  2806: sub authform_filesystem {
1.32      matthew  2807:     my %in = (
                   2808:               formname => 'document.cu',
                   2809:               kerb_def_dom => 'MSU.EDU',
                   2810:               @_,
                   2811:               );
1.586     raeburn  2812:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106    raeburn  2813:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2814:     if (defined($in{'curr_authtype'})) {
                   2815:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2816:             if ($can_assign{'fsys'}) {
1.772     bisitz   2817:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2818:                 if (defined($in{'mode'})) {
                   2819:                     if ($in{'mode'} eq 'modifyuser') {
                   2820:                         $fsyscheck = '';
                   2821:                     }
                   2822:                 }
1.586     raeburn  2823:             } else {
                   2824:                 $result = &mt('Currently Filesystem Authenticated.');
                   2825:                 return $result;
                   2826:             }           
                   2827:         }
                   2828:     } else {
                   2829:         if ($authnum == 1) {
1.784     bisitz   2830:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2831:         }
                   2832:     }
                   2833:     if (!$can_assign{'fsys'}) {
                   2834:         return;
1.587     raeburn  2835:     } elsif ($authtype eq '') {
1.591     raeburn  2836:         if (defined($in{'mode'})) {
1.587     raeburn  2837:             if ($in{'mode'} eq 'modifycourse') {
                   2838:                 if ($authnum == 1) {
1.1104    raeburn  2839:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2840:                 }
                   2841:             }
                   2842:         }
1.586     raeburn  2843:     }
                   2844:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2845:     if ($authtype eq '') {
                   2846:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2847:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2848:                     $jscall.'" />';
                   2849:     }
                   2850:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2851:                ' onchange="'.$jscall.'" />';
                   2852:     $result = &mt
1.144     matthew  2853:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2854:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2855:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2856:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2857:                   'onchange="'.$jscall.'" />');
1.32      matthew  2858:     return $result;
                   2859: }
                   2860: 
1.586     raeburn  2861: sub get_assignable_auth {
                   2862:     my ($dom) = @_;
                   2863:     if ($dom eq '') {
                   2864:         $dom = $env{'request.role.domain'};
                   2865:     }
                   2866:     my %can_assign = (
                   2867:                           krb4 => 1,
                   2868:                           krb5 => 1,
                   2869:                           int  => 1,
                   2870:                           loc  => 1,
                   2871:                      );
                   2872:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2873:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2874:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2875:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2876:             my $context;
                   2877:             if ($env{'request.role'} =~ /^au/) {
                   2878:                 $context = 'author';
                   2879:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2880:                 $context = 'domain';
                   2881:             } elsif ($env{'request.course.id'}) {
                   2882:                 $context = 'course';
                   2883:             }
                   2884:             if ($context) {
                   2885:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2886:                    %can_assign = %{$authhash->{$context}}; 
                   2887:                 }
                   2888:             }
                   2889:         }
                   2890:     }
                   2891:     my $authnum = 0;
                   2892:     foreach my $key (keys(%can_assign)) {
                   2893:         if ($can_assign{$key}) {
                   2894:             $authnum ++;
                   2895:         }
                   2896:     }
                   2897:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2898:         $authnum --;
                   2899:     }
                   2900:     return ($authnum,%can_assign);
                   2901: }
                   2902: 
1.80      albertel 2903: ###############################################################
                   2904: ##    Get Kerberos Defaults for Domain                 ##
                   2905: ###############################################################
                   2906: ##
                   2907: ## Returns default kerberos version and an associated argument
                   2908: ## as listed in file domain.tab. If not listed, provides
                   2909: ## appropriate default domain and kerberos version.
                   2910: ##
                   2911: #-------------------------------------------
                   2912: 
                   2913: =pod
                   2914: 
1.648     raeburn  2915: =item * &get_kerberos_defaults()
1.80      albertel 2916: 
                   2917: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2918: version and domain. If not found, it defaults to version 4 and the 
                   2919: domain of the server.
1.80      albertel 2920: 
1.648     raeburn  2921: =over 4
                   2922: 
1.80      albertel 2923: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2924: 
1.648     raeburn  2925: =back
                   2926: 
                   2927: =back
                   2928: 
1.80      albertel 2929: =cut
                   2930: 
                   2931: #-------------------------------------------
                   2932: sub get_kerberos_defaults {
                   2933:     my $domain=shift;
1.641     raeburn  2934:     my ($krbdef,$krbdefdom);
                   2935:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2936:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2937:         $krbdef = $domdefaults{'auth_def'};
                   2938:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2939:     } else {
1.80      albertel 2940:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2941:         my $krbdefdom=$1;
                   2942:         $krbdefdom=~tr/a-z/A-Z/;
                   2943:         $krbdef = "krb4";
                   2944:     }
                   2945:     return ($krbdef,$krbdefdom);
                   2946: }
1.112     bowersj2 2947: 
1.32      matthew  2948: 
1.46      matthew  2949: ###############################################################
                   2950: ##                Thesaurus Functions                        ##
                   2951: ###############################################################
1.20      www      2952: 
1.46      matthew  2953: =pod
1.20      www      2954: 
1.112     bowersj2 2955: =head1 Thesaurus Functions
                   2956: 
                   2957: =over 4
                   2958: 
1.648     raeburn  2959: =item * &initialize_keywords()
1.46      matthew  2960: 
                   2961: Initializes the package variable %Keywords if it is empty.  Uses the
                   2962: package variable $thesaurus_db_file.
                   2963: 
                   2964: =cut
                   2965: 
                   2966: ###################################################
                   2967: 
                   2968: sub initialize_keywords {
                   2969:     return 1 if (scalar keys(%Keywords));
                   2970:     # If we are here, %Keywords is empty, so fill it up
                   2971:     #   Make sure the file we need exists...
                   2972:     if (! -e $thesaurus_db_file) {
                   2973:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2974:                                  " failed because it does not exist");
                   2975:         return 0;
                   2976:     }
                   2977:     #   Set up the hash as a database
                   2978:     my %thesaurus_db;
                   2979:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2980:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2981:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2982:                                  $thesaurus_db_file);
                   2983:         return 0;
                   2984:     } 
                   2985:     #  Get the average number of appearances of a word.
                   2986:     my $avecount = $thesaurus_db{'average.count'};
                   2987:     #  Put keywords (those that appear > average) into %Keywords
                   2988:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2989:         my ($count,undef) = split /:/,$data;
                   2990:         $Keywords{$word}++ if ($count > $avecount);
                   2991:     }
                   2992:     untie %thesaurus_db;
                   2993:     # Remove special values from %Keywords.
1.356     albertel 2994:     foreach my $value ('total.count','average.count') {
                   2995:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2996:   }
1.46      matthew  2997:     return 1;
                   2998: }
                   2999: 
                   3000: ###################################################
                   3001: 
                   3002: =pod
                   3003: 
1.648     raeburn  3004: =item * &keyword($word)
1.46      matthew  3005: 
                   3006: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3007: than the average number of times in the thesaurus database.  Calls 
                   3008: &initialize_keywords
                   3009: 
                   3010: =cut
                   3011: 
                   3012: ###################################################
1.20      www      3013: 
                   3014: sub keyword {
1.46      matthew  3015:     return if (!&initialize_keywords());
                   3016:     my $word=lc(shift());
                   3017:     $word=~s/\W//g;
                   3018:     return exists($Keywords{$word});
1.20      www      3019: }
1.46      matthew  3020: 
                   3021: ###############################################################
                   3022: 
                   3023: =pod 
1.20      www      3024: 
1.648     raeburn  3025: =item * &get_related_words()
1.46      matthew  3026: 
1.160     matthew  3027: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3028: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3029: will be returned.  The order of the words returned is determined by the
                   3030: database which holds them.
                   3031: 
                   3032: Uses global $thesaurus_db_file.
                   3033: 
1.1057    foxr     3034: 
1.46      matthew  3035: =cut
                   3036: 
                   3037: ###############################################################
                   3038: sub get_related_words {
                   3039:     my $keyword = shift;
                   3040:     my %thesaurus_db;
                   3041:     if (! -e $thesaurus_db_file) {
                   3042:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3043:                                  "failed because the file does not exist");
                   3044:         return ();
                   3045:     }
                   3046:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3047:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3048:         return ();
                   3049:     } 
                   3050:     my @Words=();
1.429     www      3051:     my $count=0;
1.46      matthew  3052:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3053: 	# The first element is the number of times
                   3054: 	# the word appears.  We do not need it now.
1.429     www      3055: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3056: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3057: 	my $threshold=$mostfrequentcount/10;
                   3058:         foreach my $possibleword (@RelatedWords) {
                   3059:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3060:             if ($wordcount>$threshold) {
                   3061: 		push(@Words,$word);
                   3062:                 $count++;
                   3063:                 if ($count>10) { last; }
                   3064: 	    }
1.20      www      3065:         }
                   3066:     }
1.46      matthew  3067:     untie %thesaurus_db;
                   3068:     return @Words;
1.14      harris41 3069: }
1.1090    foxr     3070: ###############################################################
                   3071: #
                   3072: #  Spell checking
                   3073: #
                   3074: 
                   3075: =pod
                   3076: 
1.1142    raeburn  3077: =back
                   3078: 
1.1090    foxr     3079: =head1 Spell checking
                   3080: 
                   3081: =over 4
                   3082: 
                   3083: =item * &check_spelling($wordlist $language)
                   3084: 
                   3085: Takes a string containing words and feeds it to an external
                   3086: spellcheck program via a pipeline. Returns a string containing
                   3087: them mis-spelled words.
                   3088: 
                   3089: Parameters:
                   3090: 
                   3091: =over 4
                   3092: 
                   3093: =item - $wordlist
                   3094: 
                   3095: String that will be fed into the spellcheck program.
                   3096: 
                   3097: =item - $language
                   3098: 
                   3099: Language string that specifies the language for which the spell
                   3100: check will be performed.
                   3101: 
                   3102: =back
                   3103: 
                   3104: =back
                   3105: 
                   3106: Note: This sub assumes that aspell is installed.
                   3107: 
                   3108: 
                   3109: =cut
                   3110: 
1.46      matthew  3111: 
1.1090    foxr     3112: sub check_spelling {
                   3113:     my ($wordlist, $language) = @_;
1.1091    foxr     3114:     my @misspellings;
                   3115:     
                   3116:     # Generate the speller and set the langauge.
                   3117:     # if explicitly selected:
1.1090    foxr     3118: 
1.1091    foxr     3119:     my $speller = Text::Aspell->new;
1.1090    foxr     3120:     if ($language) {
1.1091    foxr     3121: 	$speller->set_option('lang', $language);
1.1090    foxr     3122:     }
                   3123: 
1.1091    foxr     3124:     # Turn the word list into an array of words by splittingon whitespace
1.1090    foxr     3125: 
1.1091    foxr     3126:     my @words = split(/\s+/, $wordlist);
1.1090    foxr     3127: 
1.1091    foxr     3128:     foreach my $word (@words) {
                   3129: 	if(! $speller->check($word)) {
                   3130: 	    push(@misspellings, $word);
1.1090    foxr     3131: 	}
                   3132:     }
1.1091    foxr     3133:     return join(' ', @misspellings);
                   3134:     
1.1090    foxr     3135: }
                   3136: 
1.61      www      3137: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3138: =pod
                   3139: 
1.112     bowersj2 3140: =head1 User Name Functions
                   3141: 
                   3142: =over 4
                   3143: 
1.648     raeburn  3144: =item * &plainname($uname,$udom,$first)
1.81      albertel 3145: 
1.112     bowersj2 3146: Takes a users logon name and returns it as a string in
1.226     albertel 3147: "first middle last generation" form 
                   3148: if $first is set to 'lastname' then it returns it as
                   3149: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3150: 
                   3151: =cut
1.61      www      3152: 
1.295     www      3153: 
1.81      albertel 3154: ###############################################################
1.61      www      3155: sub plainname {
1.226     albertel 3156:     my ($uname,$udom,$first)=@_;
1.537     albertel 3157:     return if (!defined($uname) || !defined($udom));
1.295     www      3158:     my %names=&getnames($uname,$udom);
1.226     albertel 3159:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3160: 					  $names{'middlename'},
                   3161: 					  $names{'lastname'},
                   3162: 					  $names{'generation'},$first);
                   3163:     $name=~s/^\s+//;
1.62      www      3164:     $name=~s/\s+$//;
                   3165:     $name=~s/\s+/ /g;
1.353     albertel 3166:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3167:     return $name;
1.61      www      3168: }
1.66      www      3169: 
                   3170: # -------------------------------------------------------------------- Nickname
1.81      albertel 3171: =pod
                   3172: 
1.648     raeburn  3173: =item * &nickname($uname,$udom)
1.81      albertel 3174: 
                   3175: Gets a users name and returns it as a string as
                   3176: 
                   3177: "&quot;nickname&quot;"
1.66      www      3178: 
1.81      albertel 3179: if the user has a nickname or
                   3180: 
                   3181: "first middle last generation"
                   3182: 
                   3183: if the user does not
                   3184: 
                   3185: =cut
1.66      www      3186: 
                   3187: sub nickname {
                   3188:     my ($uname,$udom)=@_;
1.537     albertel 3189:     return if (!defined($uname) || !defined($udom));
1.295     www      3190:     my %names=&getnames($uname,$udom);
1.68      albertel 3191:     my $name=$names{'nickname'};
1.66      www      3192:     if ($name) {
                   3193:        $name='&quot;'.$name.'&quot;'; 
                   3194:     } else {
                   3195:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3196: 	     $names{'lastname'}.' '.$names{'generation'};
                   3197:        $name=~s/\s+$//;
                   3198:        $name=~s/\s+/ /g;
                   3199:     }
                   3200:     return $name;
                   3201: }
                   3202: 
1.295     www      3203: sub getnames {
                   3204:     my ($uname,$udom)=@_;
1.537     albertel 3205:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3206:     if ($udom eq 'public' && $uname eq 'public') {
                   3207: 	return ('lastname' => &mt('Public'));
                   3208:     }
1.295     www      3209:     my $id=$uname.':'.$udom;
                   3210:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3211:     if ($cached) {
                   3212: 	return %{$names};
                   3213:     } else {
                   3214: 	my %loadnames=&Apache::lonnet::get('environment',
                   3215:                     ['firstname','middlename','lastname','generation','nickname'],
                   3216: 					 $udom,$uname);
                   3217: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3218: 	return %loadnames;
                   3219:     }
                   3220: }
1.61      www      3221: 
1.542     raeburn  3222: # -------------------------------------------------------------------- getemails
1.648     raeburn  3223: 
1.542     raeburn  3224: =pod
                   3225: 
1.648     raeburn  3226: =item * &getemails($uname,$udom)
1.542     raeburn  3227: 
                   3228: Gets a user's email information and returns it as a hash with keys:
                   3229: notification, critnotification, permanentemail
                   3230: 
                   3231: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3232: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3233:  
1.648     raeburn  3234: 
1.542     raeburn  3235: =cut
                   3236: 
1.648     raeburn  3237: 
1.466     albertel 3238: sub getemails {
                   3239:     my ($uname,$udom)=@_;
                   3240:     if ($udom eq 'public' && $uname eq 'public') {
                   3241: 	return;
                   3242:     }
1.467     www      3243:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3244:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3245:     my $id=$uname.':'.$udom;
                   3246:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3247:     if ($cached) {
                   3248: 	return %{$names};
                   3249:     } else {
                   3250: 	my %loadnames=&Apache::lonnet::get('environment',
                   3251:                     			   ['notification','critnotification',
                   3252: 					    'permanentemail'],
                   3253: 					   $udom,$uname);
                   3254: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3255: 	return %loadnames;
                   3256:     }
                   3257: }
                   3258: 
1.551     albertel 3259: sub flush_email_cache {
                   3260:     my ($uname,$udom)=@_;
                   3261:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3262:     if (!$uname) { $uname=$env{'user.name'};   }
                   3263:     return if ($udom eq 'public' && $uname eq 'public');
                   3264:     my $id=$uname.':'.$udom;
                   3265:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3266: }
                   3267: 
1.728     raeburn  3268: # -------------------------------------------------------------------- getlangs
                   3269: 
                   3270: =pod
                   3271: 
                   3272: =item * &getlangs($uname,$udom)
                   3273: 
                   3274: Gets a user's language preference and returns it as a hash with key:
                   3275: language.
                   3276: 
                   3277: =cut
                   3278: 
                   3279: 
                   3280: sub getlangs {
                   3281:     my ($uname,$udom) = @_;
                   3282:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3283:     if (!$uname) { $uname=$env{'user.name'};   }
                   3284:     my $id=$uname.':'.$udom;
                   3285:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3286:     if ($cached) {
                   3287:         return %{$langs};
                   3288:     } else {
                   3289:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3290:                                            $udom,$uname);
                   3291:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3292:         return %loadlangs;
                   3293:     }
                   3294: }
                   3295: 
                   3296: sub flush_langs_cache {
                   3297:     my ($uname,$udom)=@_;
                   3298:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3299:     if (!$uname) { $uname=$env{'user.name'};   }
                   3300:     return if ($udom eq 'public' && $uname eq 'public');
                   3301:     my $id=$uname.':'.$udom;
                   3302:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3303: }
                   3304: 
1.61      www      3305: # ------------------------------------------------------------------ Screenname
1.81      albertel 3306: 
                   3307: =pod
                   3308: 
1.648     raeburn  3309: =item * &screenname($uname,$udom)
1.81      albertel 3310: 
                   3311: Gets a users screenname and returns it as a string
                   3312: 
                   3313: =cut
1.61      www      3314: 
                   3315: sub screenname {
                   3316:     my ($uname,$udom)=@_;
1.258     albertel 3317:     if ($uname eq $env{'user.name'} &&
                   3318: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3319:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3320:     return $names{'screenname'};
1.62      www      3321: }
                   3322: 
1.212     albertel 3323: 
1.802     bisitz   3324: # ------------------------------------------------------------- Confirm Wrapper
                   3325: =pod
                   3326: 
1.1142    raeburn  3327: =item * &confirmwrapper($message)
1.802     bisitz   3328: 
                   3329: Wrap messages about completion of operation in box
                   3330: 
                   3331: =cut
                   3332: 
                   3333: sub confirmwrapper {
                   3334:     my ($message)=@_;
                   3335:     if ($message) {
                   3336:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3337:                .$message."\n"
                   3338:                .'</div>'."\n";
                   3339:     } else {
                   3340:         return $message;
                   3341:     }
                   3342: }
                   3343: 
1.62      www      3344: # ------------------------------------------------------------- Message Wrapper
                   3345: 
                   3346: sub messagewrapper {
1.369     www      3347:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3348:     return 
1.441     albertel 3349:         '<a href="/adm/email?compose=individual&amp;'.
                   3350:         'recname='.$username.'&amp;recdom='.$domain.
                   3351: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3352:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3353: }
1.802     bisitz   3354: 
1.74      www      3355: # --------------------------------------------------------------- Notes Wrapper
                   3356: 
                   3357: sub noteswrapper {
                   3358:     my ($link,$un,$do)=@_;
                   3359:     return 
1.896     amueller 3360: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3361: }
1.802     bisitz   3362: 
1.62      www      3363: # ------------------------------------------------------------- Aboutme Wrapper
                   3364: 
                   3365: sub aboutmewrapper {
1.1070    raeburn  3366:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3367:     if (!defined($username)  && !defined($domain)) {
                   3368:         return;
                   3369:     }
1.1096    raeburn  3370:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3371: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3372: }
                   3373: 
                   3374: # ------------------------------------------------------------ Syllabus Wrapper
                   3375: 
                   3376: sub syllabuswrapper {
1.707     bisitz   3377:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3378:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3379: }
1.14      harris41 3380: 
1.802     bisitz   3381: # -----------------------------------------------------------------------------
                   3382: 
1.208     matthew  3383: sub track_student_link {
1.887     raeburn  3384:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3385:     my $link ="/adm/trackstudent?";
1.208     matthew  3386:     my $title = 'View recent activity';
                   3387:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3388:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3389:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3390:         $title .= ' of this student';
1.268     albertel 3391:     } 
1.208     matthew  3392:     if (defined($target) && $target !~ /^\s*$/) {
                   3393:         $target = qq{target="$target"};
                   3394:     } else {
                   3395:         $target = '';
                   3396:     }
1.268     albertel 3397:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3398:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3399:     $title = &mt($title);
                   3400:     $linktext = &mt($linktext);
1.448     albertel 3401:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3402: 	&help_open_topic('View_recent_activity');
1.208     matthew  3403: }
                   3404: 
1.781     raeburn  3405: sub slot_reservations_link {
                   3406:     my ($linktext,$sname,$sdom,$target) = @_;
                   3407:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3408:     my $title = 'View slot reservation history';
                   3409:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3410:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3411:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3412:         $title .= ' of this student';
                   3413:     }
                   3414:     if (defined($target) && $target !~ /^\s*$/) {
                   3415:         $target = qq{target="$target"};
                   3416:     } else {
                   3417:         $target = '';
                   3418:     }
                   3419:     $title = &mt($title);
                   3420:     $linktext = &mt($linktext);
                   3421:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3422: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3423: 
                   3424: }
                   3425: 
1.508     www      3426: # ===================================================== Display a student photo
                   3427: 
                   3428: 
1.509     albertel 3429: sub student_image_tag {
1.508     www      3430:     my ($domain,$user)=@_;
                   3431:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3432:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3433: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3434:     } else {
                   3435: 	return '';
                   3436:     }
                   3437: }
                   3438: 
1.112     bowersj2 3439: =pod
                   3440: 
                   3441: =back
                   3442: 
                   3443: =head1 Access .tab File Data
                   3444: 
                   3445: =over 4
                   3446: 
1.648     raeburn  3447: =item * &languageids() 
1.112     bowersj2 3448: 
                   3449: returns list of all language ids
                   3450: 
                   3451: =cut
                   3452: 
1.14      harris41 3453: sub languageids {
1.16      harris41 3454:     return sort(keys(%language));
1.14      harris41 3455: }
                   3456: 
1.112     bowersj2 3457: =pod
                   3458: 
1.648     raeburn  3459: =item * &languagedescription() 
1.112     bowersj2 3460: 
                   3461: returns description of a specified language id
                   3462: 
                   3463: =cut
                   3464: 
1.14      harris41 3465: sub languagedescription {
1.125     www      3466:     my $code=shift;
                   3467:     return  ($supported_language{$code}?'* ':'').
                   3468:             $language{$code}.
1.126     www      3469: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3470: }
                   3471: 
1.1048    foxr     3472: =pod
                   3473: 
                   3474: =item * &plainlanguagedescription
                   3475: 
                   3476: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3477: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3478: 
                   3479: =cut
                   3480: 
1.145     www      3481: sub plainlanguagedescription {
                   3482:     my $code=shift;
                   3483:     return $language{$code};
                   3484: }
                   3485: 
1.1048    foxr     3486: =pod
                   3487: 
                   3488: =item * &supportedlanguagecode
                   3489: 
                   3490: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3491: code.
                   3492: 
                   3493: =cut
                   3494: 
1.145     www      3495: sub supportedlanguagecode {
                   3496:     my $code=shift;
                   3497:     return $supported_language{$code};
1.97      www      3498: }
                   3499: 
1.112     bowersj2 3500: =pod
                   3501: 
1.1048    foxr     3502: =item * &latexlanguage()
                   3503: 
                   3504: Given a language key code returns the correspondnig language to use
                   3505: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3506: is no supported hyphenation for the language code.
                   3507: 
                   3508: =cut
                   3509: 
                   3510: sub latexlanguage {
                   3511:     my $code = shift;
                   3512:     return $latex_language{$code};
                   3513: }
                   3514: 
                   3515: =pod
                   3516: 
                   3517: =item * &latexhyphenation()
                   3518: 
                   3519: Same as above but what's supplied is the language as it might be stored
                   3520: in the metadata.
                   3521: 
                   3522: =cut
                   3523: 
                   3524: sub latexhyphenation {
                   3525:     my $key = shift;
                   3526:     return $latex_language_bykey{$key};
                   3527: }
                   3528: 
                   3529: =pod
                   3530: 
1.648     raeburn  3531: =item * &copyrightids() 
1.112     bowersj2 3532: 
                   3533: returns list of all copyrights
                   3534: 
                   3535: =cut
                   3536: 
                   3537: sub copyrightids {
                   3538:     return sort(keys(%cprtag));
                   3539: }
                   3540: 
                   3541: =pod
                   3542: 
1.648     raeburn  3543: =item * &copyrightdescription() 
1.112     bowersj2 3544: 
                   3545: returns description of a specified copyright id
                   3546: 
                   3547: =cut
                   3548: 
                   3549: sub copyrightdescription {
1.166     www      3550:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3551: }
1.197     matthew  3552: 
                   3553: =pod
                   3554: 
1.648     raeburn  3555: =item * &source_copyrightids() 
1.192     taceyjo1 3556: 
                   3557: returns list of all source copyrights
                   3558: 
                   3559: =cut
                   3560: 
                   3561: sub source_copyrightids {
                   3562:     return sort(keys(%scprtag));
                   3563: }
                   3564: 
                   3565: =pod
                   3566: 
1.648     raeburn  3567: =item * &source_copyrightdescription() 
1.192     taceyjo1 3568: 
                   3569: returns description of a specified source copyright id
                   3570: 
                   3571: =cut
                   3572: 
                   3573: sub source_copyrightdescription {
                   3574:     return &mt($scprtag{shift(@_)});
                   3575: }
1.112     bowersj2 3576: 
                   3577: =pod
                   3578: 
1.648     raeburn  3579: =item * &filecategories() 
1.112     bowersj2 3580: 
                   3581: returns list of all file categories
                   3582: 
                   3583: =cut
                   3584: 
                   3585: sub filecategories {
                   3586:     return sort(keys(%category_extensions));
                   3587: }
                   3588: 
                   3589: =pod
                   3590: 
1.648     raeburn  3591: =item * &filecategorytypes() 
1.112     bowersj2 3592: 
                   3593: returns list of file types belonging to a given file
                   3594: category
                   3595: 
                   3596: =cut
                   3597: 
                   3598: sub filecategorytypes {
1.356     albertel 3599:     my ($cat) = @_;
                   3600:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3601: }
                   3602: 
                   3603: =pod
                   3604: 
1.648     raeburn  3605: =item * &fileembstyle() 
1.112     bowersj2 3606: 
                   3607: returns embedding style for a specified file type
                   3608: 
                   3609: =cut
                   3610: 
                   3611: sub fileembstyle {
                   3612:     return $fe{lc(shift(@_))};
1.169     www      3613: }
                   3614: 
1.351     www      3615: sub filemimetype {
                   3616:     return $fm{lc(shift(@_))};
                   3617: }
                   3618: 
1.169     www      3619: 
                   3620: sub filecategoryselect {
                   3621:     my ($name,$value)=@_;
1.189     matthew  3622:     return &select_form($value,$name,
1.970     raeburn  3623:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3624: }
                   3625: 
                   3626: =pod
                   3627: 
1.648     raeburn  3628: =item * &filedescription() 
1.112     bowersj2 3629: 
                   3630: returns description for a specified file type
                   3631: 
                   3632: =cut
                   3633: 
                   3634: sub filedescription {
1.188     matthew  3635:     my $file_description = $fd{lc(shift())};
                   3636:     $file_description =~ s:([\[\]]):~$1:g;
                   3637:     return &mt($file_description);
1.112     bowersj2 3638: }
                   3639: 
                   3640: =pod
                   3641: 
1.648     raeburn  3642: =item * &filedescriptionex() 
1.112     bowersj2 3643: 
                   3644: returns description for a specified file type with
                   3645: extra formatting
                   3646: 
                   3647: =cut
                   3648: 
                   3649: sub filedescriptionex {
                   3650:     my $ex=shift;
1.188     matthew  3651:     my $file_description = $fd{lc($ex)};
                   3652:     $file_description =~ s:([\[\]]):~$1:g;
                   3653:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3654: }
                   3655: 
                   3656: # End of .tab access
                   3657: =pod
                   3658: 
                   3659: =back
                   3660: 
                   3661: =cut
                   3662: 
                   3663: # ------------------------------------------------------------------ File Types
                   3664: sub fileextensions {
                   3665:     return sort(keys(%fe));
                   3666: }
                   3667: 
1.97      www      3668: # ----------------------------------------------------------- Display Languages
                   3669: # returns a hash with all desired display languages
                   3670: #
                   3671: 
                   3672: sub display_languages {
                   3673:     my %languages=();
1.695     raeburn  3674:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3675: 	$languages{$lang}=1;
1.97      www      3676:     }
                   3677:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3678:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3679: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3680: 	    $languages{$lang}=1;
1.97      www      3681:         }
                   3682:     }
                   3683:     return %languages;
1.14      harris41 3684: }
                   3685: 
1.582     albertel 3686: sub languages {
                   3687:     my ($possible_langs) = @_;
1.695     raeburn  3688:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3689:     if (!ref($possible_langs)) {
                   3690: 	if( wantarray ) {
                   3691: 	    return @preferred_langs;
                   3692: 	} else {
                   3693: 	    return $preferred_langs[0];
                   3694: 	}
                   3695:     }
                   3696:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3697:     my @preferred_possibilities;
                   3698:     foreach my $preferred_lang (@preferred_langs) {
                   3699: 	if (exists($possibilities{$preferred_lang})) {
                   3700: 	    push(@preferred_possibilities, $preferred_lang);
                   3701: 	}
                   3702:     }
                   3703:     if( wantarray ) {
                   3704: 	return @preferred_possibilities;
                   3705:     }
                   3706:     return $preferred_possibilities[0];
                   3707: }
                   3708: 
1.742     raeburn  3709: sub user_lang {
                   3710:     my ($touname,$toudom,$fromcid) = @_;
                   3711:     my @userlangs;
                   3712:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3713:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3714:                     $env{'course.'.$fromcid.'.languages'}));
                   3715:     } else {
                   3716:         my %langhash = &getlangs($touname,$toudom);
                   3717:         if ($langhash{'languages'} ne '') {
                   3718:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3719:         } else {
                   3720:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3721:             if ($domdefs{'lang_def'} ne '') {
                   3722:                 @userlangs = ($domdefs{'lang_def'});
                   3723:             }
                   3724:         }
                   3725:     }
                   3726:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3727:     my $user_lh = Apache::localize->get_handle(@languages);
                   3728:     return $user_lh;
                   3729: }
                   3730: 
                   3731: 
1.112     bowersj2 3732: ###############################################################
                   3733: ##               Student Answer Attempts                     ##
                   3734: ###############################################################
                   3735: 
                   3736: =pod
                   3737: 
                   3738: =head1 Alternate Problem Views
                   3739: 
                   3740: =over 4
                   3741: 
1.648     raeburn  3742: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3743:     $getattempt, $regexp, $gradesub)
                   3744: 
                   3745: Return string with previous attempt on problem. Arguments:
                   3746: 
                   3747: =over 4
                   3748: 
                   3749: =item * $symb: Problem, including path
                   3750: 
                   3751: =item * $username: username of the desired student
                   3752: 
                   3753: =item * $domain: domain of the desired student
1.14      harris41 3754: 
1.112     bowersj2 3755: =item * $course: Course ID
1.14      harris41 3756: 
1.112     bowersj2 3757: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3758:     something
1.14      harris41 3759: 
1.112     bowersj2 3760: =item * $regexp: if string matches this regexp, the string will be
                   3761:     sent to $gradesub
1.14      harris41 3762: 
1.112     bowersj2 3763: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3764: 
1.112     bowersj2 3765: =back
1.14      harris41 3766: 
1.112     bowersj2 3767: The output string is a table containing all desired attempts, if any.
1.16      harris41 3768: 
1.112     bowersj2 3769: =cut
1.1       albertel 3770: 
                   3771: sub get_previous_attempt {
1.43      ng       3772:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3773:   my $prevattempts='';
1.43      ng       3774:   no strict 'refs';
1.1       albertel 3775:   if ($symb) {
1.3       albertel 3776:     my (%returnhash)=
                   3777:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3778:     if ($returnhash{'version'}) {
                   3779:       my %lasthash=();
                   3780:       my $version;
                   3781:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3782:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3783: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3784:         }
1.1       albertel 3785:       }
1.596     albertel 3786:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3787:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3788:       my (%typeparts,%lasthidden);
1.945     raeburn  3789:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3790:       foreach my $key (sort(keys(%lasthash))) {
                   3791: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3792: 	if ($#parts > 0) {
1.31      albertel 3793: 	  my $data=$parts[-1];
1.989     raeburn  3794:           next if ($data eq 'foilorder');
1.31      albertel 3795: 	  pop(@parts);
1.1010    www      3796:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3797:           if ($data eq 'type') {
                   3798:               unless ($showsurv) {
                   3799:                   my $id = join(',',@parts);
                   3800:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3801:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3802:                       $lasthidden{$ign.'.'.$id} = 1;
                   3803:                   }
1.945     raeburn  3804:               }
1.1010    www      3805:           } 
1.31      albertel 3806: 	} else {
1.41      ng       3807: 	  if ($#parts == 0) {
                   3808: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3809: 	  } else {
                   3810: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3811: 	  }
1.31      albertel 3812: 	}
1.16      harris41 3813:       }
1.596     albertel 3814:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3815:       if ($getattempt eq '') {
                   3816: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3817:             my @hidden;
                   3818:             if (%typeparts) {
                   3819:                 foreach my $id (keys(%typeparts)) {
                   3820:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3821:                         push(@hidden,$id);
                   3822:                     }
                   3823:                 }
                   3824:             }
                   3825:             $prevattempts.=&start_data_table_row().
                   3826:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3827:             if (@hidden) {
                   3828:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3829:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3830:                     my $hide;
                   3831:                     foreach my $id (@hidden) {
                   3832:                         if ($key =~ /^\Q$id\E/) {
                   3833:                             $hide = 1;
                   3834:                             last;
                   3835:                         }
                   3836:                     }
                   3837:                     if ($hide) {
                   3838:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3839:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3840:                             my $value = &format_previous_attempt_value($key,
                   3841:                                              $returnhash{$version.':'.$key});
                   3842:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3843:                         } else {
                   3844:                             $prevattempts.='<td>&nbsp;</td>';
                   3845:                         }
                   3846:                     } else {
                   3847:                         if ($key =~ /\./) {
                   3848:                             my $value = &format_previous_attempt_value($key,
                   3849:                                               $returnhash{$version.':'.$key});
                   3850:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3851:                         } else {
                   3852:                             $prevattempts.='<td>&nbsp;</td>';
                   3853:                         }
                   3854:                     }
                   3855:                 }
                   3856:             } else {
                   3857: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3858:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3859: 		    my $value = &format_previous_attempt_value($key,
                   3860: 			            $returnhash{$version.':'.$key});
                   3861: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3862: 	        }
                   3863:             }
                   3864: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3865: 	 }
1.1       albertel 3866:       }
1.945     raeburn  3867:       my @currhidden = keys(%lasthidden);
1.596     albertel 3868:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3869:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3870:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3871:           if (%typeparts) {
                   3872:               my $hidden;
                   3873:               foreach my $id (@currhidden) {
                   3874:                   if ($key =~ /^\Q$id\E/) {
                   3875:                       $hidden = 1;
                   3876:                       last;
                   3877:                   }
                   3878:               }
                   3879:               if ($hidden) {
                   3880:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3881:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3882:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3883:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3884:                           $value = &$gradesub($value);
                   3885:                       }
                   3886:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3887:                   } else {
                   3888:                       $prevattempts.='<td>&nbsp;</td>';
                   3889:                   }
                   3890:               } else {
                   3891:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3892:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3893:                       $value = &$gradesub($value);
                   3894:                   }
                   3895:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3896:               }
                   3897:           } else {
                   3898: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3899: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3900:                   $value = &$gradesub($value);
                   3901:               }
                   3902: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3903:           }
1.16      harris41 3904:       }
1.596     albertel 3905:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3906:     } else {
1.596     albertel 3907:       $prevattempts=
                   3908: 	  &start_data_table().&start_data_table_row().
                   3909: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3910: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3911:     }
                   3912:   } else {
1.596     albertel 3913:     $prevattempts=
                   3914: 	  &start_data_table().&start_data_table_row().
                   3915: 	  '<td>'.&mt('No data.').'</td>'.
                   3916: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3917:   }
1.10      albertel 3918: }
                   3919: 
1.581     albertel 3920: sub format_previous_attempt_value {
                   3921:     my ($key,$value) = @_;
1.1011    www      3922:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3923: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3924:     } elsif (ref($value) eq 'ARRAY') {
                   3925: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3926:     } elsif ($key =~ /answerstring$/) {
                   3927:         my %answers = &Apache::lonnet::str2hash($value);
                   3928:         my @anskeys = sort(keys(%answers));
                   3929:         if (@anskeys == 1) {
                   3930:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3931:             if ($answer =~ m{\0}) {
                   3932:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3933:             }
                   3934:             my $tag_internal_answer_name = 'INTERNAL';
                   3935:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3936:                 $value = $answer; 
                   3937:             } else {
                   3938:                 $value = $anskeys[0].'='.$answer;
                   3939:             }
                   3940:         } else {
                   3941:             foreach my $ans (@anskeys) {
                   3942:                 my $answer = $answers{$ans};
1.1001    raeburn  3943:                 if ($answer =~ m{\0}) {
                   3944:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3945:                 }
                   3946:                 $value .=  $ans.'='.$answer.'<br />';;
                   3947:             } 
                   3948:         }
1.581     albertel 3949:     } else {
                   3950: 	$value = &unescape($value);
                   3951:     }
                   3952:     return $value;
                   3953: }
                   3954: 
                   3955: 
1.107     albertel 3956: sub relative_to_absolute {
                   3957:     my ($url,$output)=@_;
                   3958:     my $parser=HTML::TokeParser->new(\$output);
                   3959:     my $token;
                   3960:     my $thisdir=$url;
                   3961:     my @rlinks=();
                   3962:     while ($token=$parser->get_token) {
                   3963: 	if ($token->[0] eq 'S') {
                   3964: 	    if ($token->[1] eq 'a') {
                   3965: 		if ($token->[2]->{'href'}) {
                   3966: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3967: 		}
                   3968: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3969: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3970: 	    } elsif ($token->[1] eq 'base') {
                   3971: 		$thisdir=$token->[2]->{'href'};
                   3972: 	    }
                   3973: 	}
                   3974:     }
                   3975:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3976:     foreach my $link (@rlinks) {
1.726     raeburn  3977: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3978: 		($link=~/^\//) ||
                   3979: 		($link=~/^javascript:/i) ||
                   3980: 		($link=~/^mailto:/i) ||
                   3981: 		($link=~/^\#/)) {
                   3982: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3983: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3984: 	}
                   3985:     }
                   3986: # -------------------------------------------------- Deal with Applet codebases
                   3987:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3988:     return $output;
                   3989: }
                   3990: 
1.112     bowersj2 3991: =pod
                   3992: 
1.648     raeburn  3993: =item * &get_student_view()
1.112     bowersj2 3994: 
                   3995: show a snapshot of what student was looking at
                   3996: 
                   3997: =cut
                   3998: 
1.10      albertel 3999: sub get_student_view {
1.186     albertel 4000:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      4001:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4002:   my (%form);
1.10      albertel 4003:   my @elements=('symb','courseid','domain','username');
                   4004:   foreach my $element (@elements) {
1.186     albertel 4005:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4006:   }
1.186     albertel 4007:   if (defined($moreenv)) {
                   4008:       %form=(%form,%{$moreenv});
                   4009:   }
1.236     albertel 4010:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 4011:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      4012:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 4013:   $userview=~s/\<body[^\>]*\>//gi;
                   4014:   $userview=~s/\<\/body\>//gi;
                   4015:   $userview=~s/\<html\>//gi;
                   4016:   $userview=~s/\<\/html\>//gi;
                   4017:   $userview=~s/\<head\>//gi;
                   4018:   $userview=~s/\<\/head\>//gi;
                   4019:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 4020:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      4021:   if (wantarray) {
                   4022:      return ($userview,$response);
                   4023:   } else {
                   4024:      return $userview;
                   4025:   }
                   4026: }
                   4027: 
                   4028: sub get_student_view_with_retries {
                   4029:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   4030: 
                   4031:     my $ok = 0;                 # True if we got a good response.
                   4032:     my $content;
                   4033:     my $response;
                   4034: 
                   4035:     # Try to get the student_view done. within the retries count:
                   4036:     
                   4037:     do {
                   4038:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   4039:          $ok      = $response->is_success;
                   4040:          if (!$ok) {
                   4041:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   4042:          }
                   4043:          $retries--;
                   4044:     } while (!$ok && ($retries > 0));
                   4045:     
                   4046:     if (!$ok) {
                   4047:        $content = '';          # On error return an empty content.
                   4048:     }
1.651     www      4049:     if (wantarray) {
                   4050:        return ($content, $response);
                   4051:     } else {
                   4052:        return $content;
                   4053:     }
1.11      albertel 4054: }
                   4055: 
1.112     bowersj2 4056: =pod
                   4057: 
1.648     raeburn  4058: =item * &get_student_answers() 
1.112     bowersj2 4059: 
                   4060: show a snapshot of how student was answering problem
                   4061: 
                   4062: =cut
                   4063: 
1.11      albertel 4064: sub get_student_answers {
1.100     sakharuk 4065:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4066:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4067:   my (%moreenv);
1.11      albertel 4068:   my @elements=('symb','courseid','domain','username');
                   4069:   foreach my $element (@elements) {
1.186     albertel 4070:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4071:   }
1.186     albertel 4072:   $moreenv{'grade_target'}='answer';
                   4073:   %moreenv=(%form,%moreenv);
1.497     raeburn  4074:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4075:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4076:   return $userview;
1.1       albertel 4077: }
1.116     albertel 4078: 
                   4079: =pod
                   4080: 
                   4081: =item * &submlink()
                   4082: 
1.242     albertel 4083: Inputs: $text $uname $udom $symb $target
1.116     albertel 4084: 
                   4085: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4086: 
                   4087: =cut
                   4088: 
                   4089: ###############################################
                   4090: sub submlink {
1.242     albertel 4091:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4092:     if (!($uname && $udom)) {
                   4093: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4094: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4095: 	if (!$symb) { $symb=$cursymb; }
                   4096:     }
1.254     matthew  4097:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4098:     $symb=&escape($symb);
1.960     bisitz   4099:     if ($target) { $target=" target=\"$target\""; }
                   4100:     return
                   4101:         '<a href="/adm/grades?command=submission'.
                   4102:         '&amp;symb='.$symb.
                   4103:         '&amp;student='.$uname.
                   4104:         '&amp;userdom='.$udom.'"'.
                   4105:         $target.'>'.$text.'</a>';
1.242     albertel 4106: }
                   4107: ##############################################
                   4108: 
                   4109: =pod
                   4110: 
                   4111: =item * &pgrdlink()
                   4112: 
                   4113: Inputs: $text $uname $udom $symb $target
                   4114: 
                   4115: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4116: 
                   4117: =cut
                   4118: 
                   4119: ###############################################
                   4120: sub pgrdlink {
                   4121:     my $link=&submlink(@_);
                   4122:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4123:     return $link;
                   4124: }
                   4125: ##############################################
                   4126: 
                   4127: =pod
                   4128: 
                   4129: =item * &pprmlink()
                   4130: 
                   4131: Inputs: $text $uname $udom $symb $target
                   4132: 
                   4133: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4134: student and a specific resource
1.242     albertel 4135: 
                   4136: =cut
                   4137: 
                   4138: ###############################################
                   4139: sub pprmlink {
                   4140:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4141:     if (!($uname && $udom)) {
                   4142: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4143: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4144: 	if (!$symb) { $symb=$cursymb; }
                   4145:     }
1.254     matthew  4146:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4147:     $symb=&escape($symb);
1.242     albertel 4148:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4149:     return '<a href="/adm/parmset?command=set&amp;'.
                   4150: 	'symb='.$symb.'&amp;uname='.$uname.
                   4151: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4152: }
                   4153: ##############################################
1.37      matthew  4154: 
1.112     bowersj2 4155: =pod
                   4156: 
                   4157: =back
                   4158: 
                   4159: =cut
                   4160: 
1.37      matthew  4161: ###############################################
1.51      www      4162: 
                   4163: 
                   4164: sub timehash {
1.687     raeburn  4165:     my ($thistime) = @_;
                   4166:     my $timezone = &Apache::lonlocal::gettimezone();
                   4167:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4168:                      ->set_time_zone($timezone);
                   4169:     my $wday = $dt->day_of_week();
                   4170:     if ($wday == 7) { $wday = 0; }
                   4171:     return ( 'second' => $dt->second(),
                   4172:              'minute' => $dt->minute(),
                   4173:              'hour'   => $dt->hour(),
                   4174:              'day'     => $dt->day_of_month(),
                   4175:              'month'   => $dt->month(),
                   4176:              'year'    => $dt->year(),
                   4177:              'weekday' => $wday,
                   4178:              'dayyear' => $dt->day_of_year(),
                   4179:              'dlsav'   => $dt->is_dst() );
1.51      www      4180: }
                   4181: 
1.370     www      4182: sub utc_string {
                   4183:     my ($date)=@_;
1.371     www      4184:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4185: }
                   4186: 
1.51      www      4187: sub maketime {
                   4188:     my %th=@_;
1.687     raeburn  4189:     my ($epoch_time,$timezone,$dt);
                   4190:     $timezone = &Apache::lonlocal::gettimezone();
                   4191:     eval {
                   4192:         $dt = DateTime->new( year   => $th{'year'},
                   4193:                              month  => $th{'month'},
                   4194:                              day    => $th{'day'},
                   4195:                              hour   => $th{'hour'},
                   4196:                              minute => $th{'minute'},
                   4197:                              second => $th{'second'},
                   4198:                              time_zone => $timezone,
                   4199:                          );
                   4200:     };
                   4201:     if (!$@) {
                   4202:         $epoch_time = $dt->epoch;
                   4203:         if ($epoch_time) {
                   4204:             return $epoch_time;
                   4205:         }
                   4206:     }
1.51      www      4207:     return POSIX::mktime(
                   4208:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4209:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4210: }
                   4211: 
                   4212: #########################################
1.51      www      4213: 
                   4214: sub findallcourses {
1.482     raeburn  4215:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4216:     my %roles;
                   4217:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4218:     my %courses;
1.51      www      4219:     my $now=time;
1.482     raeburn  4220:     if (!defined($uname)) {
                   4221:         $uname = $env{'user.name'};
                   4222:     }
                   4223:     if (!defined($udom)) {
                   4224:         $udom = $env{'user.domain'};
                   4225:     }
                   4226:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4227:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4228:         if (!%roles) {
                   4229:             %roles = (
                   4230:                        cc => 1,
1.907     raeburn  4231:                        co => 1,
1.482     raeburn  4232:                        in => 1,
                   4233:                        ep => 1,
                   4234:                        ta => 1,
                   4235:                        cr => 1,
                   4236:                        st => 1,
                   4237:              );
                   4238:         }
                   4239:         foreach my $entry (keys(%roleshash)) {
                   4240:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4241:             if ($trole =~ /^cr/) { 
                   4242:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4243:             } else {
                   4244:                 next if (!exists($roles{$trole}));
                   4245:             }
                   4246:             if ($tend) {
                   4247:                 next if ($tend < $now);
                   4248:             }
                   4249:             if ($tstart) {
                   4250:                 next if ($tstart > $now);
                   4251:             }
1.1058    raeburn  4252:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4253:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4254:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4255:             if ($secpart eq '') {
                   4256:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4257:                 $sec = 'none';
1.1058    raeburn  4258:                 $value .= $cnum.'/';
1.482     raeburn  4259:             } else {
                   4260:                 $cnum = $cnumpart;
                   4261:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4262:                 $value .= $cnum.'/'.$sec;
                   4263:             }
                   4264:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4265:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4266:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4267:                 }
                   4268:             } else {
                   4269:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4270:             }
1.482     raeburn  4271:         }
                   4272:     } else {
                   4273:         foreach my $key (keys(%env)) {
1.483     albertel 4274: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4275:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4276: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4277: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4278: 	        next if (%roles && !exists($roles{$role}));
                   4279: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4280:                 my $active=1;
                   4281:                 if ($starttime) {
                   4282: 		    if ($now<$starttime) { $active=0; }
                   4283:                 }
                   4284:                 if ($endtime) {
                   4285:                     if ($now>$endtime) { $active=0; }
                   4286:                 }
                   4287:                 if ($active) {
1.1058    raeburn  4288:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4289:                     if ($sec eq '') {
                   4290:                         $sec = 'none';
1.1058    raeburn  4291:                     } else {
                   4292:                         $value .= $sec;
                   4293:                     }
                   4294:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4295:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4296:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4297:                         }
                   4298:                     } else {
                   4299:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4300:                     }
1.474     raeburn  4301:                 }
                   4302:             }
1.51      www      4303:         }
                   4304:     }
1.474     raeburn  4305:     return %courses;
1.51      www      4306: }
1.37      matthew  4307: 
1.54      www      4308: ###############################################
1.474     raeburn  4309: 
                   4310: sub blockcheck {
1.1062    raeburn  4311:     my ($setters,$activity,$uname,$udom,$url) = @_;
1.490     raeburn  4312: 
                   4313:     if (!defined($udom)) {
                   4314:         $udom = $env{'user.domain'};
                   4315:     }
                   4316:     if (!defined($uname)) {
                   4317:         $uname = $env{'user.name'};
                   4318:     }
                   4319: 
                   4320:     # If uname and udom are for a course, check for blocks in the course.
                   4321: 
                   4322:     if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062    raeburn  4323:         my ($startblock,$endblock,$triggerblock) = 
                   4324:             &get_blocks($setters,$activity,$udom,$uname,$url);
                   4325:         return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4326:     }
1.474     raeburn  4327: 
1.502     raeburn  4328:     my $startblock = 0;
                   4329:     my $endblock = 0;
1.1062    raeburn  4330:     my $triggerblock = '';
1.482     raeburn  4331:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4332: 
1.490     raeburn  4333:     # If uname is for a user, and activity is course-specific, i.e.,
                   4334:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4335: 
1.490     raeburn  4336:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4337:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4338:         foreach my $key (keys(%live_courses)) {
                   4339:             if ($key ne $env{'request.course.id'}) {
                   4340:                 delete($live_courses{$key});
                   4341:             }
                   4342:         }
                   4343:     }
                   4344: 
                   4345:     my $otheruser = 0;
                   4346:     my %own_courses;
                   4347:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4348:         # Resource belongs to user other than current user.
                   4349:         $otheruser = 1;
                   4350:         # Gather courses for current user
                   4351:         %own_courses = 
                   4352:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4353:     }
                   4354: 
                   4355:     # Gather active course roles - course coordinator, instructor, 
                   4356:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4357: 
                   4358:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4359:         my ($cdom,$cnum);
                   4360:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4361:             $cdom = $env{'course.'.$course.'.domain'};
                   4362:             $cnum = $env{'course.'.$course.'.num'};
                   4363:         } else {
1.490     raeburn  4364:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4365:         }
                   4366:         my $no_ownblock = 0;
                   4367:         my $no_userblock = 0;
1.533     raeburn  4368:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4369:             # Check if current user has 'evb' priv for this
                   4370:             if (defined($own_courses{$course})) {
                   4371:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4372:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4373:                     if ($sec ne 'none') {
                   4374:                         $checkrole .= '/'.$sec;
                   4375:                     }
                   4376:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4377:                         $no_ownblock = 1;
                   4378:                         last;
                   4379:                     }
                   4380:                 }
                   4381:             }
                   4382:             # if they have 'evb' priv and are currently not playing student
                   4383:             next if (($no_ownblock) &&
                   4384:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4385:         }
1.474     raeburn  4386:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4387:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4388:             if ($sec ne 'none') {
1.482     raeburn  4389:                 $checkrole .= '/'.$sec;
1.474     raeburn  4390:             }
1.490     raeburn  4391:             if ($otheruser) {
                   4392:                 # Resource belongs to user other than current user.
                   4393:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4394:                 my (%allroles,%userroles);
                   4395:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4396:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4397:                         my ($trole,$tdom,$tnum,$tsec);
                   4398:                         if ($entry =~ /^cr/) {
                   4399:                             ($trole,$tdom,$tnum,$tsec) = 
                   4400:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4401:                         } else {
                   4402:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4403:                         }
                   4404:                         my ($spec,$area,$trest);
                   4405:                         $area = '/'.$tdom.'/'.$tnum;
                   4406:                         $trest = $tnum;
                   4407:                         if ($tsec ne '') {
                   4408:                             $area .= '/'.$tsec;
                   4409:                             $trest .= '/'.$tsec;
                   4410:                         }
                   4411:                         $spec = $trole.'.'.$area;
                   4412:                         if ($trole =~ /^cr/) {
                   4413:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4414:                                                               $tdom,$spec,$trest,$area);
                   4415:                         } else {
                   4416:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4417:                                                                 $tdom,$spec,$trest,$area);
                   4418:                         }
                   4419:                     }
                   4420:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4421:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4422:                         if ($1) {
                   4423:                             $no_userblock = 1;
                   4424:                             last;
                   4425:                         }
1.486     raeburn  4426:                     }
                   4427:                 }
1.490     raeburn  4428:             } else {
                   4429:                 # Resource belongs to current user
                   4430:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4431:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4432:                     $no_ownblock = 1;
                   4433:                     last;
                   4434:                 }
1.474     raeburn  4435:             }
                   4436:         }
                   4437:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4438:         next if (($no_ownblock) &&
1.491     albertel 4439:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4440:         next if ($no_userblock);
1.474     raeburn  4441: 
1.866     kalberla 4442:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4443:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4444:         
1.1062    raeburn  4445:         my ($start,$end,$trigger) = 
                   4446:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4447:         if (($start != 0) && 
                   4448:             (($startblock == 0) || ($startblock > $start))) {
                   4449:             $startblock = $start;
1.1062    raeburn  4450:             if ($trigger ne '') {
                   4451:                 $triggerblock = $trigger;
                   4452:             }
1.502     raeburn  4453:         }
                   4454:         if (($end != 0)  &&
                   4455:             (($endblock == 0) || ($endblock < $end))) {
                   4456:             $endblock = $end;
1.1062    raeburn  4457:             if ($trigger ne '') {
                   4458:                 $triggerblock = $trigger;
                   4459:             }
1.502     raeburn  4460:         }
1.490     raeburn  4461:     }
1.1062    raeburn  4462:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4463: }
                   4464: 
                   4465: sub get_blocks {
1.1062    raeburn  4466:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4467:     my $startblock = 0;
                   4468:     my $endblock = 0;
1.1062    raeburn  4469:     my $triggerblock = '';
1.490     raeburn  4470:     my $course = $cdom.'_'.$cnum;
                   4471:     $setters->{$course} = {};
                   4472:     $setters->{$course}{'staff'} = [];
                   4473:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4474:     $setters->{$course}{'triggers'} = [];
                   4475:     my (@blockers,%triggered);
                   4476:     my $now = time;
                   4477:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4478:     if ($activity eq 'docs') {
                   4479:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4480:         foreach my $block (@blockers) {
                   4481:             if ($block =~ /^firstaccess____(.+)$/) {
                   4482:                 my $item = $1;
                   4483:                 my $type = 'map';
                   4484:                 my $timersymb = $item;
                   4485:                 if ($item eq 'course') {
                   4486:                     $type = 'course';
                   4487:                 } elsif ($item =~ /___\d+___/) {
                   4488:                     $type = 'resource';
                   4489:                 } else {
                   4490:                     $timersymb = &Apache::lonnet::symbread($item);
                   4491:                 }
                   4492:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4493:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4494:                 $triggered{$block} = {
                   4495:                                        start => $start,
                   4496:                                        end   => $end,
                   4497:                                        type  => $type,
                   4498:                                      };
                   4499:             }
                   4500:         }
                   4501:     } else {
                   4502:         foreach my $block (keys(%commblocks)) {
                   4503:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4504:                 my ($start,$end) = ($1,$2);
                   4505:                 if ($start <= time && $end >= time) {
                   4506:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4507:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4508:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4509:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4510:                                     push(@blockers,$block);
                   4511:                                 }
                   4512:                             }
                   4513:                         }
                   4514:                     }
                   4515:                 }
                   4516:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4517:                 my $item = $1;
                   4518:                 my $timersymb = $item; 
                   4519:                 my $type = 'map';
                   4520:                 if ($item eq 'course') {
                   4521:                     $type = 'course';
                   4522:                 } elsif ($item =~ /___\d+___/) {
                   4523:                     $type = 'resource';
                   4524:                 } else {
                   4525:                     $timersymb = &Apache::lonnet::symbread($item);
                   4526:                 }
                   4527:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4528:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4529:                 if ($start && $end) {
                   4530:                     if (($start <= time) && ($end >= time)) {
                   4531:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4532:                             push(@blockers,$block);
                   4533:                             $triggered{$block} = {
                   4534:                                                    start => $start,
                   4535:                                                    end   => $end,
                   4536:                                                    type  => $type,
                   4537:                                                  };
                   4538:                         }
                   4539:                     }
1.490     raeburn  4540:                 }
1.1062    raeburn  4541:             }
                   4542:         }
                   4543:     }
                   4544:     foreach my $blocker (@blockers) {
                   4545:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4546:             &parse_block_record($commblocks{$blocker});
                   4547:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4548:         my ($start,$end,$triggertype);
                   4549:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4550:             ($start,$end) = ($1,$2);
                   4551:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4552:             $start = $triggered{$blocker}{'start'};
                   4553:             $end = $triggered{$blocker}{'end'};
                   4554:             $triggertype = $triggered{$blocker}{'type'};
                   4555:         }
                   4556:         if ($start) {
                   4557:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4558:             if ($triggertype) {
                   4559:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4560:             } else {
                   4561:                 push(@{$$setters{$course}{'triggers'}},0);
                   4562:             }
                   4563:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4564:                 $startblock = $start;
                   4565:                 if ($triggertype) {
                   4566:                     $triggerblock = $blocker;
1.474     raeburn  4567:                 }
                   4568:             }
1.1062    raeburn  4569:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4570:                $endblock = $end;
                   4571:                if ($triggertype) {
                   4572:                    $triggerblock = $blocker;
                   4573:                }
                   4574:             }
1.474     raeburn  4575:         }
                   4576:     }
1.1062    raeburn  4577:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4578: }
                   4579: 
                   4580: sub parse_block_record {
                   4581:     my ($record) = @_;
                   4582:     my ($setuname,$setudom,$title,$blocks);
                   4583:     if (ref($record) eq 'HASH') {
                   4584:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4585:         $title = &unescape($record->{'event'});
                   4586:         $blocks = $record->{'blocks'};
                   4587:     } else {
                   4588:         my @data = split(/:/,$record,3);
                   4589:         if (scalar(@data) eq 2) {
                   4590:             $title = $data[1];
                   4591:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4592:         } else {
                   4593:             ($setuname,$setudom,$title) = @data;
                   4594:         }
                   4595:         $blocks = { 'com' => 'on' };
                   4596:     }
                   4597:     return ($setuname,$setudom,$title,$blocks);
                   4598: }
                   4599: 
1.854     kalberla 4600: sub blocking_status {
1.1062    raeburn  4601:     my ($activity,$uname,$udom,$url) = @_;
1.1061    raeburn  4602:     my %setters;
1.890     droeschl 4603: 
1.1061    raeburn  4604: # check for active blocking
1.1062    raeburn  4605:     my ($startblock,$endblock,$triggerblock) = 
                   4606:         &blockcheck(\%setters,$activity,$uname,$udom,$url);
                   4607:     my $blocked = 0;
                   4608:     if ($startblock && $endblock) {
                   4609:         $blocked = 1;
                   4610:     }
1.890     droeschl 4611: 
1.1061    raeburn  4612: # caller just wants to know whether a block is active
                   4613:     if (!wantarray) { return $blocked; }
                   4614: 
                   4615: # build a link to a popup window containing the details
                   4616:     my $querystring  = "?activity=$activity";
                   4617: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4618:     if ($activity eq 'port') {
                   4619:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4620:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4621:     } elsif ($activity eq 'docs') {
                   4622:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4623:     }
1.1061    raeburn  4624: 
                   4625:     my $output .= <<'END_MYBLOCK';
                   4626: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4627:     var options = "width=" + w + ",height=" + h + ",";
                   4628:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4629:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4630:     var newWin = window.open(url, wdwName, options);
                   4631:     newWin.focus();
                   4632: }
1.890     droeschl 4633: END_MYBLOCK
1.854     kalberla 4634: 
1.1061    raeburn  4635:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4636:   
1.1061    raeburn  4637:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4638:     my $text = &mt('Communication Blocked');
                   4639:     if ($activity eq 'docs') {
                   4640:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4641:     } elsif ($activity eq 'printout') {
                   4642:         $text = &mt('Printing Blocked');
1.1062    raeburn  4643:     }
1.1061    raeburn  4644:     $output .= <<"END_BLOCK";
1.867     kalberla 4645: <div class='LC_comblock'>
1.869     kalberla 4646:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4647:   title='$text'>
                   4648:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4649:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4650:   title='$text'>$text</a>
1.867     kalberla 4651: </div>
                   4652: 
                   4653: END_BLOCK
1.474     raeburn  4654: 
1.1061    raeburn  4655:     return ($blocked, $output);
1.854     kalberla 4656: }
1.490     raeburn  4657: 
1.60      matthew  4658: ###############################################
                   4659: 
1.682     raeburn  4660: sub check_ip_acc {
                   4661:     my ($acc)=@_;
                   4662:     &Apache::lonxml::debug("acc is $acc");
                   4663:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4664:         return 1;
                   4665:     }
                   4666:     my $allowed=0;
                   4667:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4668: 
                   4669:     my $name;
                   4670:     foreach my $pattern (split(',',$acc)) {
                   4671:         $pattern =~ s/^\s*//;
                   4672:         $pattern =~ s/\s*$//;
                   4673:         if ($pattern =~ /\*$/) {
                   4674:             #35.8.*
                   4675:             $pattern=~s/\*//;
                   4676:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4677:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4678:             #35.8.3.[34-56]
                   4679:             my $low=$2;
                   4680:             my $high=$3;
                   4681:             $pattern=$1;
                   4682:             if ($ip =~ /^\Q$pattern\E/) {
                   4683:                 my $last=(split(/\./,$ip))[3];
                   4684:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4685:             }
                   4686:         } elsif ($pattern =~ /^\*/) {
                   4687:             #*.msu.edu
                   4688:             $pattern=~s/\*//;
                   4689:             if (!defined($name)) {
                   4690:                 use Socket;
                   4691:                 my $netaddr=inet_aton($ip);
                   4692:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4693:             }
                   4694:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4695:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4696:             #127.0.0.1
                   4697:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4698:         } else {
                   4699:             #some.name.com
                   4700:             if (!defined($name)) {
                   4701:                 use Socket;
                   4702:                 my $netaddr=inet_aton($ip);
                   4703:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4704:             }
                   4705:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4706:         }
                   4707:         if ($allowed) { last; }
                   4708:     }
                   4709:     return $allowed;
                   4710: }
                   4711: 
                   4712: ###############################################
                   4713: 
1.60      matthew  4714: =pod
                   4715: 
1.112     bowersj2 4716: =head1 Domain Template Functions
                   4717: 
                   4718: =over 4
                   4719: 
                   4720: =item * &determinedomain()
1.60      matthew  4721: 
                   4722: Inputs: $domain (usually will be undef)
                   4723: 
1.63      www      4724: Returns: Determines which domain should be used for designs
1.60      matthew  4725: 
                   4726: =cut
1.54      www      4727: 
1.60      matthew  4728: ###############################################
1.63      www      4729: sub determinedomain {
                   4730:     my $domain=shift;
1.531     albertel 4731:     if (! $domain) {
1.60      matthew  4732:         # Determine domain if we have not been given one
1.893     raeburn  4733:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4734:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4735:         if ($env{'request.role.domain'}) { 
                   4736:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4737:         }
                   4738:     }
1.63      www      4739:     return $domain;
                   4740: }
                   4741: ###############################################
1.517     raeburn  4742: 
1.518     albertel 4743: sub devalidate_domconfig_cache {
                   4744:     my ($udom)=@_;
                   4745:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4746: }
                   4747: 
                   4748: # ---------------------- Get domain configuration for a domain
                   4749: sub get_domainconf {
                   4750:     my ($udom) = @_;
                   4751:     my $cachetime=1800;
                   4752:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4753:     if (defined($cached)) { return %{$result}; }
                   4754: 
                   4755:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4756: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4757:     my (%designhash,%legacy);
1.518     albertel 4758:     if (keys(%domconfig) > 0) {
                   4759:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4760:             if (keys(%{$domconfig{'login'}})) {
                   4761:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4762:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4763:                         if ($key eq 'loginvia') {
                   4764:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4765:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4766:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4767:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4768:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4769:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4770:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4771: 
                   4772:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4773:                                             } else {
1.1013    raeburn  4774:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4775:                                             }
                   4776:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4777:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4778:                                             }
1.946     raeburn  4779:                                         }
                   4780:                                     }
                   4781:                                 }
                   4782:                             }
                   4783:                         } else {
                   4784:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4785:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4786:                                     $domconfig{'login'}{$key}{$img};
                   4787:                             }
1.699     raeburn  4788:                         }
                   4789:                     } else {
                   4790:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4791:                     }
1.632     raeburn  4792:                 }
                   4793:             } else {
                   4794:                 $legacy{'login'} = 1;
1.518     albertel 4795:             }
1.632     raeburn  4796:         } else {
                   4797:             $legacy{'login'} = 1;
1.518     albertel 4798:         }
                   4799:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4800:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4801:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4802:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4803:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4804:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4805:                         }
1.518     albertel 4806:                     }
                   4807:                 }
1.632     raeburn  4808:             } else {
                   4809:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4810:             }
1.632     raeburn  4811:         } else {
                   4812:             $legacy{'rolecolors'} = 1;
1.518     albertel 4813:         }
1.948     raeburn  4814:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4815:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4816:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4817:             }
                   4818:         }
1.632     raeburn  4819:         if (keys(%legacy) > 0) {
                   4820:             my %legacyhash = &get_legacy_domconf($udom);
                   4821:             foreach my $item (keys(%legacyhash)) {
                   4822:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4823:                     if ($legacy{'login'}) { 
                   4824:                         $designhash{$item} = $legacyhash{$item};
                   4825:                     }
                   4826:                 } else {
                   4827:                     if ($legacy{'rolecolors'}) {
                   4828:                         $designhash{$item} = $legacyhash{$item};
                   4829:                     }
1.518     albertel 4830:                 }
                   4831:             }
                   4832:         }
1.632     raeburn  4833:     } else {
                   4834:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4835:     }
                   4836:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4837: 				  $cachetime);
                   4838:     return %designhash;
                   4839: }
                   4840: 
1.632     raeburn  4841: sub get_legacy_domconf {
                   4842:     my ($udom) = @_;
                   4843:     my %legacyhash;
                   4844:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4845:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4846:     if (-e $designfile) {
                   4847:         if ( open (my $fh,"<$designfile") ) {
                   4848:             while (my $line = <$fh>) {
                   4849:                 next if ($line =~ /^\#/);
                   4850:                 chomp($line);
                   4851:                 my ($key,$val)=(split(/\=/,$line));
                   4852:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4853:             }
                   4854:             close($fh);
                   4855:         }
                   4856:     }
1.1026    raeburn  4857:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4858:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4859:     }
                   4860:     return %legacyhash;
                   4861: }
                   4862: 
1.63      www      4863: =pod
                   4864: 
1.112     bowersj2 4865: =item * &domainlogo()
1.63      www      4866: 
                   4867: Inputs: $domain (usually will be undef)
                   4868: 
                   4869: Returns: A link to a domain logo, if the domain logo exists.
                   4870: If the domain logo does not exist, a description of the domain.
                   4871: 
                   4872: =cut
1.112     bowersj2 4873: 
1.63      www      4874: ###############################################
                   4875: sub domainlogo {
1.517     raeburn  4876:     my $domain = &determinedomain(shift);
1.518     albertel 4877:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4878:     # See if there is a logo
                   4879:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4880:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4881:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4882: 	    if ($imgsrc =~ m{^/res/}) {
                   4883: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4884: 		&Apache::lonnet::repcopy($local_name);
                   4885: 	    }
                   4886: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4887:         } 
                   4888:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4889:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4890:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4891:     } else {
1.60      matthew  4892:         return '';
1.59      www      4893:     }
                   4894: }
1.63      www      4895: ##############################################
                   4896: 
                   4897: =pod
                   4898: 
1.112     bowersj2 4899: =item * &designparm()
1.63      www      4900: 
                   4901: Inputs: $which parameter; $domain (usually will be undef)
                   4902: 
                   4903: Returns: value of designparamter $which
                   4904: 
                   4905: =cut
1.112     bowersj2 4906: 
1.397     albertel 4907: 
1.400     albertel 4908: ##############################################
1.397     albertel 4909: sub designparm {
                   4910:     my ($which,$domain)=@_;
                   4911:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4912:         return $env{'environment.color.'.$which};
1.96      www      4913:     }
1.63      www      4914:     $domain=&determinedomain($domain);
1.1016    raeburn  4915:     my %domdesign;
                   4916:     unless ($domain eq 'public') {
                   4917:         %domdesign = &get_domainconf($domain);
                   4918:     }
1.520     raeburn  4919:     my $output;
1.517     raeburn  4920:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4921:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4922:     } else {
1.520     raeburn  4923:         $output = $defaultdesign{$which};
                   4924:     }
                   4925:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4926:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4927:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4928:             if ($output =~ m{^/res/}) {
                   4929:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4930:                 &Apache::lonnet::repcopy($local_name);
                   4931:             }
1.520     raeburn  4932:             $output = &lonhttpdurl($output);
                   4933:         }
1.63      www      4934:     }
1.520     raeburn  4935:     return $output;
1.63      www      4936: }
1.59      www      4937: 
1.822     bisitz   4938: ##############################################
                   4939: =pod
                   4940: 
1.832     bisitz   4941: =item * &authorspace()
                   4942: 
1.1028    raeburn  4943: Inputs: $url (usually will be undef).
1.832     bisitz   4944: 
1.1132    raeburn  4945: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  4946:          directory being viewed (or for which action is being taken). 
                   4947:          If $url is provided, and begins /priv/<domain>/<uname>
                   4948:          the path will be that portion of the $context argument.
                   4949:          Otherwise the path will be for the author space of the current
                   4950:          user when the current role is author, or for that of the 
                   4951:          co-author/assistant co-author space when the current role 
                   4952:          is co-author or assistant co-author.
1.832     bisitz   4953: 
                   4954: =cut
                   4955: 
                   4956: sub authorspace {
1.1028    raeburn  4957:     my ($url) = @_;
                   4958:     if ($url ne '') {
                   4959:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4960:            return $1;
                   4961:         }
                   4962:     }
1.832     bisitz   4963:     my $caname = '';
1.1024    www      4964:     my $cadom = '';
1.1028    raeburn  4965:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4966:         ($cadom,$caname) =
1.832     bisitz   4967:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4968:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4969:         $caname = $env{'user.name'};
1.1024    www      4970:         $cadom = $env{'user.domain'};
1.832     bisitz   4971:     }
1.1028    raeburn  4972:     if (($caname ne '') && ($cadom ne '')) {
                   4973:         return "/priv/$cadom/$caname/";
                   4974:     }
                   4975:     return;
1.832     bisitz   4976: }
                   4977: 
                   4978: ##############################################
                   4979: =pod
                   4980: 
1.822     bisitz   4981: =item * &head_subbox()
                   4982: 
                   4983: Inputs: $content (contains HTML code with page functions, etc.)
                   4984: 
                   4985: Returns: HTML div with $content
                   4986:          To be included in page header
                   4987: 
                   4988: =cut
                   4989: 
                   4990: sub head_subbox {
                   4991:     my ($content)=@_;
                   4992:     my $output =
1.993     raeburn  4993:         '<div class="LC_head_subbox">'
1.822     bisitz   4994:        .$content
                   4995:        .'</div>'
                   4996: }
                   4997: 
                   4998: ##############################################
                   4999: =pod
                   5000: 
                   5001: =item * &CSTR_pageheader()
                   5002: 
1.1026    raeburn  5003: Input: (optional) filename from which breadcrumb trail is built.
                   5004:        In most cases no input as needed, as $env{'request.filename'}
                   5005:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   5006: 
                   5007: Returns: HTML div with CSTR path and recent box
1.1132    raeburn  5008:          To be included on Authoring Space pages
1.822     bisitz   5009: 
                   5010: =cut
                   5011: 
                   5012: sub CSTR_pageheader {
1.1026    raeburn  5013:     my ($trailfile) = @_;
                   5014:     if ($trailfile eq '') {
                   5015:         $trailfile = $env{'request.filename'};
                   5016:     }
                   5017: 
                   5018: # this is for resources; directories have customtitle, and crumbs
                   5019: # and select recent are created in lonpubdir.pm
                   5020: 
                   5021:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      5022:     my ($udom,$uname,$thisdisfn)=
1.1113    raeburn  5023:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  5024:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   5025:     $formaction =~ s{/+}{/}g;
1.822     bisitz   5026: 
                   5027:     my $parentpath = '';
                   5028:     my $lastitem = '';
                   5029:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   5030:         $parentpath = $1;
                   5031:         $lastitem = $2;
                   5032:     } else {
                   5033:         $lastitem = $thisdisfn;
                   5034:     }
1.921     bisitz   5035: 
                   5036:     my $output =
1.822     bisitz   5037:          '<div>'
                   5038:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132    raeburn  5039:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   5040:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   5041:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      5042:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   5043: 
                   5044:     if ($lastitem) {
                   5045:         $output .=
                   5046:              '<span class="LC_filename">'
                   5047:             .$lastitem
                   5048:             .'</span>';
                   5049:     }
                   5050:     $output .=
                   5051:          '<br />'
1.822     bisitz   5052:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   5053:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   5054:         .'</form>'
                   5055:         .&Apache::lonmenu::constspaceform()
                   5056:         .'</div>';
1.921     bisitz   5057: 
                   5058:     return $output;
1.822     bisitz   5059: }
                   5060: 
1.60      matthew  5061: ###############################################
                   5062: ###############################################
                   5063: 
                   5064: =pod
                   5065: 
1.112     bowersj2 5066: =back
                   5067: 
1.549     albertel 5068: =head1 HTML Helpers
1.112     bowersj2 5069: 
                   5070: =over 4
                   5071: 
                   5072: =item * &bodytag()
1.60      matthew  5073: 
                   5074: Returns a uniform header for LON-CAPA web pages.
                   5075: 
                   5076: Inputs: 
                   5077: 
1.112     bowersj2 5078: =over 4
                   5079: 
                   5080: =item * $title, A title to be displayed on the page.
                   5081: 
                   5082: =item * $function, the current role (can be undef).
                   5083: 
                   5084: =item * $addentries, extra parameters for the <body> tag.
                   5085: 
                   5086: =item * $bodyonly, if defined, only return the <body> tag.
                   5087: 
                   5088: =item * $domain, if defined, force a given domain.
                   5089: 
                   5090: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5091:             text interface only)
1.60      matthew  5092: 
1.814     bisitz   5093: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5094:                      navigational links
1.317     albertel 5095: 
1.338     albertel 5096: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5097: 
1.460     albertel 5098: =item * $args, optional argument valid values are
                   5099:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5100:             inherit_jsmath -> when creating popup window in a page,
                   5101:                               should it have jsmath forced on by the
                   5102:                               current page
1.460     albertel 5103: 
1.1096    raeburn  5104: =item * $advtoolsref, optional argument, ref to an array containing
                   5105:             inlineremote items to be added in "Functions" menu below
                   5106:             breadcrumbs.
                   5107: 
1.112     bowersj2 5108: =back
                   5109: 
1.60      matthew  5110: Returns: A uniform header for LON-CAPA web pages.  
                   5111: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5112: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5113: other decorations will be returned.
                   5114: 
                   5115: =cut
                   5116: 
1.54      www      5117: sub bodytag {
1.831     bisitz   5118:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096    raeburn  5119:         $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339     albertel 5120: 
1.954     raeburn  5121:     my $public;
                   5122:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5123:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5124:         $public = 1;
                   5125:     }
1.460     albertel 5126:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.339     albertel 5127: 
1.183     matthew  5128:     $function = &get_users_function() if (!$function);
1.339     albertel 5129:     my $img =    &designparm($function.'.img',$domain);
                   5130:     my $font =   &designparm($function.'.font',$domain);
                   5131:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5132: 
1.803     bisitz   5133:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5134: 		   'bgcolor' => $pgbg,
1.339     albertel 5135: 		   'text'    => $font,
                   5136:                    'alink'   => &designparm($function.'.alink',$domain),
                   5137: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5138: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5139:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5140: 
1.63      www      5141:  # role and realm
1.378     raeburn  5142:     my ($role,$realm) = split(/\./,$env{'request.role'},2);
                   5143:     if ($role  eq 'ca') {
1.479     albertel 5144:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5145:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5146:     } 
1.55      www      5147: # realm
1.258     albertel 5148:     if ($env{'request.course.id'}) {
1.378     raeburn  5149:         if ($env{'request.role'} !~ /^cr/) {
                   5150:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5151:         }
1.898     raeburn  5152:         if ($env{'request.course.sec'}) {
                   5153:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5154:         }   
1.359     albertel 5155: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5156:     } else {
                   5157:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5158:     }
1.433     albertel 5159: 
1.359     albertel 5160:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5161: 
1.438     albertel 5162:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5163: 
1.101     www      5164: # construct main body tag
1.359     albertel 5165:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5166: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5167: 
1.1131    raeburn  5168:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5169: 
1.1130    raeburn  5170:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5171:         return $bodytag;
1.1130    raeburn  5172:     }
1.359     albertel 5173: 
1.954     raeburn  5174:     if ($public) {
1.433     albertel 5175: 	undef($role);
                   5176:     }
1.359     albertel 5177:     
1.762     bisitz   5178:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5179:     #
                   5180:     # Extra info if you are the DC
                   5181:     my $dc_info = '';
                   5182:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5183:                         $env{'course.'.$env{'request.course.id'}.
                   5184:                                  '.domain'}.'/'})) {
                   5185:         my $cid = $env{'request.course.id'};
1.917     raeburn  5186:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5187:         $dc_info =~ s/\s+$//;
1.359     albertel 5188:     }
                   5189: 
1.898     raeburn  5190:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853     droeschl 5191: 
1.903     droeschl 5192:         if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5193: 
                   5194:         #    if ($env{'request.state'} eq 'construct') {
                   5195:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5196:         #    }
                   5197: 
1.1130    raeburn  5198:         $bodytag .= Apache::lonhtmlcommon::scripttag(
                   5199:             Apache::lonmenu::utilityfunctions(), 'start');
1.359     albertel 5200: 
1.1130    raeburn  5201:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.359     albertel 5202: 
1.916     droeschl 5203:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917     raeburn  5204:              if ($dc_info) {
                   5205:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
                   5206:              }
1.1130    raeburn  5207:              $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916     droeschl 5208:                 <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5209:             return $bodytag;
                   5210:         }
1.894     droeschl 5211: 
1.927     raeburn  5212:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130    raeburn  5213:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5214:         }
1.916     droeschl 5215: 
1.1130    raeburn  5216:         $bodytag .= $right;
1.852     droeschl 5217: 
1.917     raeburn  5218:         if ($dc_info) {
                   5219:             $dc_info = &dc_courseid_toggle($dc_info);
                   5220:         }
                   5221:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5222: 
1.903     droeschl 5223:         #don't show menus for public users
1.954     raeburn  5224:         if (!$public){
1.903     droeschl 5225:             $bodytag .= Apache::lonmenu::secondary_menu();
                   5226:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5227:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5228:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5229:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5230:                                 $args->{'bread_crumbs'});
1.1096    raeburn  5231:             } elsif ($forcereg) {
                   5232:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5233:                                                             $args->{'group'});
                   5234:             } else {
                   5235:                 $bodytag .= 
                   5236:                     &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5237:                                                         $forcereg,$args->{'group'},
                   5238:                                                         $args->{'bread_crumbs'},
                   5239:                                                         $advtoolsref);
1.920     raeburn  5240:             }
1.903     droeschl 5241:         }else{
                   5242:             # this is to seperate menu from content when there's no secondary
                   5243:             # menu. Especially needed for public accessible ressources.
                   5244:             $bodytag .= '<hr style="clear:both" />';
                   5245:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5246:         }
1.903     droeschl 5247: 
1.235     raeburn  5248:         return $bodytag;
1.182     matthew  5249: }
                   5250: 
1.917     raeburn  5251: sub dc_courseid_toggle {
                   5252:     my ($dc_info) = @_;
1.980     raeburn  5253:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5254:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5255:            &mt('(More ...)').'</a></span>'.
                   5256:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5257: }
                   5258: 
1.330     albertel 5259: sub make_attr_string {
                   5260:     my ($register,$attr_ref) = @_;
                   5261: 
                   5262:     if ($attr_ref && !ref($attr_ref)) {
                   5263: 	die("addentries Must be a hash ref ".
                   5264: 	    join(':',caller(1))." ".
                   5265: 	    join(':',caller(0))." ");
                   5266:     }
                   5267: 
                   5268:     if ($register) {
1.339     albertel 5269: 	my ($on_load,$on_unload);
                   5270: 	foreach my $key (keys(%{$attr_ref})) {
                   5271: 	    if      (lc($key) eq 'onload') {
                   5272: 		$on_load.=$attr_ref->{$key}.';';
                   5273: 		delete($attr_ref->{$key});
                   5274: 
                   5275: 	    } elsif (lc($key) eq 'onunload') {
                   5276: 		$on_unload.=$attr_ref->{$key}.';';
                   5277: 		delete($attr_ref->{$key});
                   5278: 	    }
                   5279: 	}
1.953     droeschl 5280: 	$attr_ref->{'onload'}  = $on_load;
                   5281: 	$attr_ref->{'onunload'}= $on_unload;
1.330     albertel 5282:     }
1.339     albertel 5283: 
1.330     albertel 5284:     my $attr_string;
                   5285:     foreach my $attr (keys(%$attr_ref)) {
                   5286: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5287:     }
                   5288:     return $attr_string;
                   5289: }
                   5290: 
                   5291: 
1.182     matthew  5292: ###############################################
1.251     albertel 5293: ###############################################
                   5294: 
                   5295: =pod
                   5296: 
                   5297: =item * &endbodytag()
                   5298: 
                   5299: Returns a uniform footer for LON-CAPA web pages.
                   5300: 
1.635     raeburn  5301: Inputs: 1 - optional reference to an args hash
                   5302: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5303: a 'Continue' link is not displayed if the page contains an
                   5304: internal redirect in the <head></head> section,
                   5305: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5306: 
                   5307: =cut
                   5308: 
                   5309: sub endbodytag {
1.635     raeburn  5310:     my ($args) = @_;
1.1080    raeburn  5311:     my $endbodytag;
                   5312:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5313:         $endbodytag='</body>';
                   5314:     }
1.269     albertel 5315:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5316:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5317:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5318: 	    $endbodytag=
                   5319: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5320: 	        &mt('Continue').'</a>'.
                   5321: 	        $endbodytag;
                   5322:         }
1.315     albertel 5323:     }
1.251     albertel 5324:     return $endbodytag;
                   5325: }
                   5326: 
1.352     albertel 5327: =pod
                   5328: 
                   5329: =item * &standard_css()
                   5330: 
                   5331: Returns a style sheet
                   5332: 
                   5333: Inputs: (all optional)
                   5334:             domain         -> force to color decorate a page for a specific
                   5335:                                domain
                   5336:             function       -> force usage of a specific rolish color scheme
                   5337:             bgcolor        -> override the default page bgcolor
                   5338: 
                   5339: =cut
                   5340: 
1.343     albertel 5341: sub standard_css {
1.345     albertel 5342:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5343:     $function  = &get_users_function() if (!$function);
                   5344:     my $img    = &designparm($function.'.img',   $domain);
                   5345:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5346:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5347:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5348: #second colour for later usage
1.345     albertel 5349:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5350:     my $pgbg_or_bgcolor =
                   5351: 	         $bgcolor ||
1.352     albertel 5352: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5353:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5354:     my $alink  = &designparm($function.'.alink', $domain);
                   5355:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5356:     my $link   = &designparm($function.'.link',  $domain);
                   5357: 
1.602     albertel 5358:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5359:     my $mono                 = 'monospace';
1.850     bisitz   5360:     my $data_table_head      = $sidebg;
                   5361:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5362:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5363:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5364:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5365:     my $mail_new             = '#FFBB77';
                   5366:     my $mail_new_hover       = '#DD9955';
                   5367:     my $mail_read            = '#BBBB77';
                   5368:     my $mail_read_hover      = '#999944';
                   5369:     my $mail_replied         = '#AAAA88';
                   5370:     my $mail_replied_hover   = '#888855';
                   5371:     my $mail_other           = '#99BBBB';
                   5372:     my $mail_other_hover     = '#669999';
1.391     albertel 5373:     my $table_header         = '#DDDDDD';
1.489     raeburn  5374:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5375:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5376:     my $button_hover         = '#BF2317';
1.392     albertel 5377: 
1.608     albertel 5378:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5379:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5380:                                              : '0 3px 0 4px';
1.448     albertel 5381: 
1.523     albertel 5382: 
1.343     albertel 5383:     return <<END;
1.947     droeschl 5384: 
                   5385: /* needed for iframe to allow 100% height in FF */
                   5386: body, html { 
                   5387:     margin: 0;
                   5388:     padding: 0 0.5%;
                   5389:     height: 99%; /* to avoid scrollbars */
                   5390: }
                   5391: 
1.795     www      5392: body {
1.911     bisitz   5393:   font-family: $sans;
                   5394:   line-height:130%;
                   5395:   font-size:0.83em;
                   5396:   color:$font;
1.795     www      5397: }
                   5398: 
1.959     onken    5399: a:focus,
                   5400: a:focus img {
1.795     www      5401:   color: red;
                   5402: }
1.698     harmsja  5403: 
1.911     bisitz   5404: form, .inline {
                   5405:   display: inline;
1.795     www      5406: }
1.721     harmsja  5407: 
1.795     www      5408: .LC_right {
1.911     bisitz   5409:   text-align:right;
1.795     www      5410: }
                   5411: 
                   5412: .LC_middle {
1.911     bisitz   5413:   vertical-align:middle;
1.795     www      5414: }
1.721     harmsja  5415: 
1.1130    raeburn  5416: .LC_floatleft {
                   5417:   float: left;
                   5418: }
                   5419: 
                   5420: .LC_floatright {
                   5421:   float: right;
                   5422: }
                   5423: 
1.911     bisitz   5424: .LC_400Box {
                   5425:   width:400px;
                   5426: }
1.721     harmsja  5427: 
1.947     droeschl 5428: .LC_iframecontainer {
                   5429:     width: 98%;
                   5430:     margin: 0;
                   5431:     position: fixed;
                   5432:     top: 8.5em;
                   5433:     bottom: 0;
                   5434: }
                   5435: 
                   5436: .LC_iframecontainer iframe{
                   5437:     border: none;
                   5438:     width: 100%;
                   5439:     height: 100%;
                   5440: }
                   5441: 
1.778     bisitz   5442: .LC_filename {
                   5443:   font-family: $mono;
                   5444:   white-space:pre;
1.921     bisitz   5445:   font-size: 120%;
1.778     bisitz   5446: }
                   5447: 
                   5448: .LC_fileicon {
                   5449:   border: none;
                   5450:   height: 1.3em;
                   5451:   vertical-align: text-bottom;
                   5452:   margin-right: 0.3em;
                   5453:   text-decoration:none;
                   5454: }
                   5455: 
1.1008    www      5456: .LC_setting {
                   5457:   text-decoration:underline;
                   5458: }
                   5459: 
1.350     albertel 5460: .LC_error {
                   5461:   color: red;
                   5462: }
1.795     www      5463: 
1.1097    bisitz   5464: .LC_warning {
                   5465:   color: darkorange;
                   5466: }
                   5467: 
1.457     albertel 5468: .LC_diff_removed {
1.733     bisitz   5469:   color: red;
1.394     albertel 5470: }
1.532     albertel 5471: 
                   5472: .LC_info,
1.457     albertel 5473: .LC_success,
                   5474: .LC_diff_added {
1.350     albertel 5475:   color: green;
                   5476: }
1.795     www      5477: 
1.802     bisitz   5478: div.LC_confirm_box {
                   5479:   background-color: #FAFAFA;
                   5480:   border: 1px solid $lg_border_color;
                   5481:   margin-right: 0;
                   5482:   padding: 5px;
                   5483: }
                   5484: 
                   5485: div.LC_confirm_box .LC_error img,
                   5486: div.LC_confirm_box .LC_success img {
                   5487:   vertical-align: middle;
                   5488: }
                   5489: 
1.440     albertel 5490: .LC_icon {
1.771     droeschl 5491:   border: none;
1.790     droeschl 5492:   vertical-align: middle;
1.771     droeschl 5493: }
                   5494: 
1.543     albertel 5495: .LC_docs_spacer {
                   5496:   width: 25px;
                   5497:   height: 1px;
1.771     droeschl 5498:   border: none;
1.543     albertel 5499: }
1.346     albertel 5500: 
1.532     albertel 5501: .LC_internal_info {
1.735     bisitz   5502:   color: #999999;
1.532     albertel 5503: }
                   5504: 
1.794     www      5505: .LC_discussion {
1.1050    www      5506:   background: $data_table_dark;
1.911     bisitz   5507:   border: 1px solid black;
                   5508:   margin: 2px;
1.794     www      5509: }
                   5510: 
                   5511: .LC_disc_action_left {
1.1050    www      5512:   background: $sidebg;
1.911     bisitz   5513:   text-align: left;
1.1050    www      5514:   padding: 4px;
                   5515:   margin: 2px;
1.794     www      5516: }
                   5517: 
                   5518: .LC_disc_action_right {
1.1050    www      5519:   background: $sidebg;
1.911     bisitz   5520:   text-align: right;
1.1050    www      5521:   padding: 4px;
                   5522:   margin: 2px;
1.794     www      5523: }
                   5524: 
                   5525: .LC_disc_new_item {
1.911     bisitz   5526:   background: white;
                   5527:   border: 2px solid red;
1.1050    www      5528:   margin: 4px;
                   5529:   padding: 4px;
1.794     www      5530: }
                   5531: 
                   5532: .LC_disc_old_item {
1.911     bisitz   5533:   background: white;
1.1050    www      5534:   margin: 4px;
                   5535:   padding: 4px;
1.794     www      5536: }
                   5537: 
1.458     albertel 5538: table.LC_pastsubmission {
                   5539:   border: 1px solid black;
                   5540:   margin: 2px;
                   5541: }
                   5542: 
1.924     bisitz   5543: table#LC_menubuttons {
1.345     albertel 5544:   width: 100%;
                   5545:   background: $pgbg;
1.392     albertel 5546:   border: 2px;
1.402     albertel 5547:   border-collapse: separate;
1.803     bisitz   5548:   padding: 0;
1.345     albertel 5549: }
1.392     albertel 5550: 
1.801     tempelho 5551: table#LC_title_bar a {
                   5552:   color: $fontmenu;
                   5553: }
1.836     bisitz   5554: 
1.807     droeschl 5555: table#LC_title_bar {
1.819     tempelho 5556:   clear: both;
1.836     bisitz   5557:   display: none;
1.807     droeschl 5558: }
                   5559: 
1.795     www      5560: table#LC_title_bar,
1.933     droeschl 5561: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5562: table#LC_title_bar.LC_with_remote {
1.359     albertel 5563:   width: 100%;
1.392     albertel 5564:   border-color: $pgbg;
                   5565:   border-style: solid;
                   5566:   border-width: $border;
1.379     albertel 5567:   background: $pgbg;
1.801     tempelho 5568:   color: $fontmenu;
1.392     albertel 5569:   border-collapse: collapse;
1.803     bisitz   5570:   padding: 0;
1.819     tempelho 5571:   margin: 0;
1.359     albertel 5572: }
1.795     www      5573: 
1.933     droeschl 5574: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5575:     margin: 0;
                   5576:     padding: 0;
1.933     droeschl 5577:     position: relative;
                   5578:     list-style: none;
1.913     droeschl 5579: }
1.933     droeschl 5580: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5581:     display: inline;
                   5582: }
1.933     droeschl 5583: 
                   5584: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5585:     padding: 0;
1.933     droeschl 5586:     margin: 0;
                   5587:     float: left;
1.913     droeschl 5588: }
1.933     droeschl 5589: .LC_breadcrumb_tools_tools {
                   5590:     padding: 0;
                   5591:     margin: 0;
1.913     droeschl 5592:     float: right;
                   5593: }
                   5594: 
1.359     albertel 5595: table#LC_title_bar td {
                   5596:   background: $tabbg;
                   5597: }
1.795     www      5598: 
1.911     bisitz   5599: table#LC_menubuttons img {
1.803     bisitz   5600:   border: none;
1.346     albertel 5601: }
1.795     www      5602: 
1.842     droeschl 5603: .LC_breadcrumbs_component {
1.911     bisitz   5604:   float: right;
                   5605:   margin: 0 1em;
1.357     albertel 5606: }
1.842     droeschl 5607: .LC_breadcrumbs_component img {
1.911     bisitz   5608:   vertical-align: middle;
1.777     tempelho 5609: }
1.795     www      5610: 
1.383     albertel 5611: td.LC_table_cell_checkbox {
                   5612:   text-align: center;
                   5613: }
1.795     www      5614: 
                   5615: .LC_fontsize_small {
1.911     bisitz   5616:   font-size: 70%;
1.705     tempelho 5617: }
                   5618: 
1.844     bisitz   5619: #LC_breadcrumbs {
1.911     bisitz   5620:   clear:both;
                   5621:   background: $sidebg;
                   5622:   border-bottom: 1px solid $lg_border_color;
                   5623:   line-height: 2.5em;
1.933     droeschl 5624:   overflow: hidden;
1.911     bisitz   5625:   margin: 0;
                   5626:   padding: 0;
1.995     raeburn  5627:   text-align: left;
1.819     tempelho 5628: }
1.862     bisitz   5629: 
1.1098    bisitz   5630: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5631:   clear:both;
                   5632:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5633:   border: 1px solid $sidebg;
1.1098    bisitz   5634:   margin: 0 0 10px 0;
1.966     bisitz   5635:   padding: 3px;
1.995     raeburn  5636:   text-align: left;
1.822     bisitz   5637: }
                   5638: 
1.795     www      5639: .LC_fontsize_medium {
1.911     bisitz   5640:   font-size: 85%;
1.705     tempelho 5641: }
                   5642: 
1.795     www      5643: .LC_fontsize_large {
1.911     bisitz   5644:   font-size: 120%;
1.705     tempelho 5645: }
                   5646: 
1.346     albertel 5647: .LC_menubuttons_inline_text {
                   5648:   color: $font;
1.698     harmsja  5649:   font-size: 90%;
1.701     harmsja  5650:   padding-left:3px;
1.346     albertel 5651: }
                   5652: 
1.934     droeschl 5653: .LC_menubuttons_inline_text img{
                   5654:   vertical-align: middle;
                   5655: }
                   5656: 
1.1051    www      5657: li.LC_menubuttons_inline_text img {
1.951     onken    5658:   cursor:pointer;
1.1002    droeschl 5659:   text-decoration: none;
1.951     onken    5660: }
                   5661: 
1.526     www      5662: .LC_menubuttons_link {
                   5663:   text-decoration: none;
                   5664: }
1.795     www      5665: 
1.522     albertel 5666: .LC_menubuttons_category {
1.521     www      5667:   color: $font;
1.526     www      5668:   background: $pgbg;
1.521     www      5669:   font-size: larger;
                   5670:   font-weight: bold;
                   5671: }
                   5672: 
1.346     albertel 5673: td.LC_menubuttons_text {
1.911     bisitz   5674:   color: $font;
1.346     albertel 5675: }
1.706     harmsja  5676: 
1.346     albertel 5677: .LC_current_location {
                   5678:   background: $tabbg;
                   5679: }
1.795     www      5680: 
1.938     bisitz   5681: table.LC_data_table {
1.347     albertel 5682:   border: 1px solid #000000;
1.402     albertel 5683:   border-collapse: separate;
1.426     albertel 5684:   border-spacing: 1px;
1.610     albertel 5685:   background: $pgbg;
1.347     albertel 5686: }
1.795     www      5687: 
1.422     albertel 5688: .LC_data_table_dense {
                   5689:   font-size: small;
                   5690: }
1.795     www      5691: 
1.507     raeburn  5692: table.LC_nested_outer {
                   5693:   border: 1px solid #000000;
1.589     raeburn  5694:   border-collapse: collapse;
1.803     bisitz   5695:   border-spacing: 0;
1.507     raeburn  5696:   width: 100%;
                   5697: }
1.795     www      5698: 
1.879     raeburn  5699: table.LC_innerpickbox,
1.507     raeburn  5700: table.LC_nested {
1.803     bisitz   5701:   border: none;
1.589     raeburn  5702:   border-collapse: collapse;
1.803     bisitz   5703:   border-spacing: 0;
1.507     raeburn  5704:   width: 100%;
                   5705: }
1.795     www      5706: 
1.911     bisitz   5707: table.LC_data_table tr th,
                   5708: table.LC_calendar tr th,
1.879     raeburn  5709: table.LC_prior_tries tr th,
                   5710: table.LC_innerpickbox tr th {
1.349     albertel 5711:   font-weight: bold;
                   5712:   background-color: $data_table_head;
1.801     tempelho 5713:   color:$fontmenu;
1.701     harmsja  5714:   font-size:90%;
1.347     albertel 5715: }
1.795     www      5716: 
1.879     raeburn  5717: table.LC_innerpickbox tr th,
                   5718: table.LC_innerpickbox tr td {
                   5719:   vertical-align: top;
                   5720: }
                   5721: 
1.711     raeburn  5722: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5723:   background-color: #CCCCCC;
1.711     raeburn  5724:   font-weight: bold;
                   5725:   text-align: left;
                   5726: }
1.795     www      5727: 
1.912     bisitz   5728: table.LC_data_table tr.LC_odd_row > td {
                   5729:   background-color: $data_table_light;
                   5730:   padding: 2px;
                   5731:   vertical-align: top;
                   5732: }
                   5733: 
1.809     bisitz   5734: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5735:   background-color: $data_table_light;
1.912     bisitz   5736:   vertical-align: top;
                   5737: }
                   5738: 
                   5739: table.LC_data_table tr.LC_even_row > td {
                   5740:   background-color: $data_table_dark;
1.425     albertel 5741:   padding: 2px;
1.900     bisitz   5742:   vertical-align: top;
1.347     albertel 5743: }
1.795     www      5744: 
1.809     bisitz   5745: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5746:   background-color: $data_table_dark;
1.900     bisitz   5747:   vertical-align: top;
1.347     albertel 5748: }
1.795     www      5749: 
1.425     albertel 5750: table.LC_data_table tr.LC_data_table_highlight td {
                   5751:   background-color: $data_table_darker;
                   5752: }
1.795     www      5753: 
1.639     raeburn  5754: table.LC_data_table tr td.LC_leftcol_header {
                   5755:   background-color: $data_table_head;
                   5756:   font-weight: bold;
                   5757: }
1.795     www      5758: 
1.451     albertel 5759: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5760: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5761:   font-weight: bold;
                   5762:   font-style: italic;
                   5763:   text-align: center;
                   5764:   padding: 8px;
1.347     albertel 5765: }
1.795     www      5766: 
1.1114    raeburn  5767: table.LC_data_table tr.LC_empty_row td,
                   5768: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   5769:   background-color: $sidebg;
                   5770: }
                   5771: 
                   5772: table.LC_nested tr.LC_empty_row td {
                   5773:   background-color: #FFFFFF;
                   5774: }
                   5775: 
1.890     droeschl 5776: table.LC_caption {
                   5777: }
                   5778: 
1.507     raeburn  5779: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5780:   padding: 4ex
                   5781: }
1.795     www      5782: 
1.507     raeburn  5783: table.LC_nested_outer tr th {
                   5784:   font-weight: bold;
1.801     tempelho 5785:   color:$fontmenu;
1.507     raeburn  5786:   background-color: $data_table_head;
1.701     harmsja  5787:   font-size: small;
1.507     raeburn  5788:   border-bottom: 1px solid #000000;
                   5789: }
1.795     www      5790: 
1.507     raeburn  5791: table.LC_nested_outer tr td.LC_subheader {
                   5792:   background-color: $data_table_head;
                   5793:   font-weight: bold;
                   5794:   font-size: small;
                   5795:   border-bottom: 1px solid #000000;
                   5796:   text-align: right;
1.451     albertel 5797: }
1.795     www      5798: 
1.507     raeburn  5799: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5800:   background-color: #CCCCCC;
1.451     albertel 5801:   font-weight: bold;
                   5802:   font-size: small;
1.507     raeburn  5803:   text-align: center;
                   5804: }
1.795     www      5805: 
1.589     raeburn  5806: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5807: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5808:   text-align: left;
1.451     albertel 5809: }
1.795     www      5810: 
1.507     raeburn  5811: table.LC_nested td {
1.735     bisitz   5812:   background-color: #FFFFFF;
1.451     albertel 5813:   font-size: small;
1.507     raeburn  5814: }
1.795     www      5815: 
1.507     raeburn  5816: table.LC_nested_outer tr th.LC_right_item,
                   5817: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5818: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5819: table.LC_nested tr td.LC_right_item {
1.451     albertel 5820:   text-align: right;
                   5821: }
                   5822: 
1.507     raeburn  5823: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5824:   background-color: #EEEEEE;
1.451     albertel 5825: }
                   5826: 
1.473     raeburn  5827: table.LC_createuser {
                   5828: }
                   5829: 
                   5830: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5831:   font-size: small;
1.473     raeburn  5832: }
                   5833: 
                   5834: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5835:   background-color: #CCCCCC;
1.473     raeburn  5836:   font-weight: bold;
                   5837:   text-align: center;
                   5838: }
                   5839: 
1.349     albertel 5840: table.LC_calendar {
                   5841:   border: 1px solid #000000;
                   5842:   border-collapse: collapse;
1.917     raeburn  5843:   width: 98%;
1.349     albertel 5844: }
1.795     www      5845: 
1.349     albertel 5846: table.LC_calendar_pickdate {
                   5847:   font-size: xx-small;
                   5848: }
1.795     www      5849: 
1.349     albertel 5850: table.LC_calendar tr td {
                   5851:   border: 1px solid #000000;
                   5852:   vertical-align: top;
1.917     raeburn  5853:   width: 14%;
1.349     albertel 5854: }
1.795     www      5855: 
1.349     albertel 5856: table.LC_calendar tr td.LC_calendar_day_empty {
                   5857:   background-color: $data_table_dark;
                   5858: }
1.795     www      5859: 
1.779     bisitz   5860: table.LC_calendar tr td.LC_calendar_day_current {
                   5861:   background-color: $data_table_highlight;
1.777     tempelho 5862: }
1.795     www      5863: 
1.938     bisitz   5864: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5865:   background-color: $mail_new;
                   5866: }
1.795     www      5867: 
1.938     bisitz   5868: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5869:   background-color: $mail_new_hover;
                   5870: }
1.795     www      5871: 
1.938     bisitz   5872: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5873:   background-color: $mail_read;
                   5874: }
1.795     www      5875: 
1.938     bisitz   5876: /*
                   5877: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5878:   background-color: $mail_read_hover;
                   5879: }
1.938     bisitz   5880: */
1.795     www      5881: 
1.938     bisitz   5882: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5883:   background-color: $mail_replied;
                   5884: }
1.795     www      5885: 
1.938     bisitz   5886: /*
                   5887: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5888:   background-color: $mail_replied_hover;
                   5889: }
1.938     bisitz   5890: */
1.795     www      5891: 
1.938     bisitz   5892: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5893:   background-color: $mail_other;
                   5894: }
1.795     www      5895: 
1.938     bisitz   5896: /*
                   5897: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5898:   background-color: $mail_other_hover;
                   5899: }
1.938     bisitz   5900: */
1.494     raeburn  5901: 
1.777     tempelho 5902: table.LC_data_table tr > td.LC_browser_file,
                   5903: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5904:   background: #AAEE77;
1.389     albertel 5905: }
1.795     www      5906: 
1.777     tempelho 5907: table.LC_data_table tr > td.LC_browser_file_locked,
                   5908: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5909:   background: #FFAA99;
1.387     albertel 5910: }
1.795     www      5911: 
1.777     tempelho 5912: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5913:   background: #888888;
1.779     bisitz   5914: }
1.795     www      5915: 
1.777     tempelho 5916: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5917: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5918:   background: #F8F866;
1.777     tempelho 5919: }
1.795     www      5920: 
1.696     bisitz   5921: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5922:   background: #E0E8FF;
1.387     albertel 5923: }
1.696     bisitz   5924: 
1.707     bisitz   5925: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5926:   /* background: #77FF77; */
1.707     bisitz   5927: }
1.795     www      5928: 
1.707     bisitz   5929: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5930:   border-right: 8px solid #FFFF77;
1.707     bisitz   5931: }
1.795     www      5932: 
1.707     bisitz   5933: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5934:   border-right: 8px solid #FFAA77;
1.707     bisitz   5935: }
1.795     www      5936: 
1.707     bisitz   5937: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5938:   border-right: 8px solid #FF7777;
1.707     bisitz   5939: }
1.795     www      5940: 
1.707     bisitz   5941: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5942:   border-right: 8px solid #AAFF77;
1.707     bisitz   5943: }
1.795     www      5944: 
1.707     bisitz   5945: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5946:   border-right: 8px solid #11CC55;
1.707     bisitz   5947: }
                   5948: 
1.388     albertel 5949: span.LC_current_location {
1.701     harmsja  5950:   font-size:larger;
1.388     albertel 5951:   background: $pgbg;
                   5952: }
1.387     albertel 5953: 
1.1029    www      5954: span.LC_current_nav_location {
                   5955:   font-weight:bold;
                   5956:   background: $sidebg;
                   5957: }
                   5958: 
1.395     albertel 5959: span.LC_parm_menu_item {
                   5960:   font-size: larger;
                   5961: }
1.795     www      5962: 
1.395     albertel 5963: span.LC_parm_scope_all {
                   5964:   color: red;
                   5965: }
1.795     www      5966: 
1.395     albertel 5967: span.LC_parm_scope_folder {
                   5968:   color: green;
                   5969: }
1.795     www      5970: 
1.395     albertel 5971: span.LC_parm_scope_resource {
                   5972:   color: orange;
                   5973: }
1.795     www      5974: 
1.395     albertel 5975: span.LC_parm_part {
                   5976:   color: blue;
                   5977: }
1.795     www      5978: 
1.911     bisitz   5979: span.LC_parm_folder,
                   5980: span.LC_parm_symb {
1.395     albertel 5981:   font-size: x-small;
                   5982:   font-family: $mono;
                   5983:   color: #AAAAAA;
                   5984: }
                   5985: 
1.977     bisitz   5986: ul.LC_parm_parmlist li {
                   5987:   display: inline-block;
                   5988:   padding: 0.3em 0.8em;
                   5989:   vertical-align: top;
                   5990:   width: 150px;
                   5991:   border-top:1px solid $lg_border_color;
                   5992: }
                   5993: 
1.795     www      5994: td.LC_parm_overview_level_menu,
                   5995: td.LC_parm_overview_map_menu,
                   5996: td.LC_parm_overview_parm_selectors,
                   5997: td.LC_parm_overview_restrictions  {
1.396     albertel 5998:   border: 1px solid black;
                   5999:   border-collapse: collapse;
                   6000: }
1.795     www      6001: 
1.396     albertel 6002: table.LC_parm_overview_restrictions td {
                   6003:   border-width: 1px 4px 1px 4px;
                   6004:   border-style: solid;
                   6005:   border-color: $pgbg;
                   6006:   text-align: center;
                   6007: }
1.795     www      6008: 
1.396     albertel 6009: table.LC_parm_overview_restrictions th {
                   6010:   background: $tabbg;
                   6011:   border-width: 1px 4px 1px 4px;
                   6012:   border-style: solid;
                   6013:   border-color: $pgbg;
                   6014: }
1.795     www      6015: 
1.398     albertel 6016: table#LC_helpmenu {
1.803     bisitz   6017:   border: none;
1.398     albertel 6018:   height: 55px;
1.803     bisitz   6019:   border-spacing: 0;
1.398     albertel 6020: }
                   6021: 
                   6022: table#LC_helpmenu fieldset legend {
                   6023:   font-size: larger;
                   6024: }
1.795     www      6025: 
1.397     albertel 6026: table#LC_helpmenu_links {
                   6027:   width: 100%;
                   6028:   border: 1px solid black;
                   6029:   background: $pgbg;
1.803     bisitz   6030:   padding: 0;
1.397     albertel 6031:   border-spacing: 1px;
                   6032: }
1.795     www      6033: 
1.397     albertel 6034: table#LC_helpmenu_links tr td {
                   6035:   padding: 1px;
                   6036:   background: $tabbg;
1.399     albertel 6037:   text-align: center;
                   6038:   font-weight: bold;
1.397     albertel 6039: }
1.396     albertel 6040: 
1.795     www      6041: table#LC_helpmenu_links a:link,
                   6042: table#LC_helpmenu_links a:visited,
1.397     albertel 6043: table#LC_helpmenu_links a:active {
                   6044:   text-decoration: none;
                   6045:   color: $font;
                   6046: }
1.795     www      6047: 
1.397     albertel 6048: table#LC_helpmenu_links a:hover {
                   6049:   text-decoration: underline;
                   6050:   color: $vlink;
                   6051: }
1.396     albertel 6052: 
1.417     albertel 6053: .LC_chrt_popup_exists {
                   6054:   border: 1px solid #339933;
                   6055:   margin: -1px;
                   6056: }
1.795     www      6057: 
1.417     albertel 6058: .LC_chrt_popup_up {
                   6059:   border: 1px solid yellow;
                   6060:   margin: -1px;
                   6061: }
1.795     www      6062: 
1.417     albertel 6063: .LC_chrt_popup {
                   6064:   border: 1px solid #8888FF;
                   6065:   background: #CCCCFF;
                   6066: }
1.795     www      6067: 
1.421     albertel 6068: table.LC_pick_box {
                   6069:   border-collapse: separate;
                   6070:   background: white;
                   6071:   border: 1px solid black;
                   6072:   border-spacing: 1px;
                   6073: }
1.795     www      6074: 
1.421     albertel 6075: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6076:   background: $sidebg;
1.421     albertel 6077:   font-weight: bold;
1.900     bisitz   6078:   text-align: left;
1.740     bisitz   6079:   vertical-align: top;
1.421     albertel 6080:   width: 184px;
                   6081:   padding: 8px;
                   6082: }
1.795     www      6083: 
1.579     raeburn  6084: table.LC_pick_box td.LC_pick_box_value {
                   6085:   text-align: left;
                   6086:   padding: 8px;
                   6087: }
1.795     www      6088: 
1.579     raeburn  6089: table.LC_pick_box td.LC_pick_box_select {
                   6090:   text-align: left;
                   6091:   padding: 8px;
                   6092: }
1.795     www      6093: 
1.424     albertel 6094: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6095:   padding: 0;
1.421     albertel 6096:   height: 1px;
                   6097:   background: black;
                   6098: }
1.795     www      6099: 
1.421     albertel 6100: table.LC_pick_box td.LC_pick_box_submit {
                   6101:   text-align: right;
                   6102: }
1.795     www      6103: 
1.579     raeburn  6104: table.LC_pick_box td.LC_evenrow_value {
                   6105:   text-align: left;
                   6106:   padding: 8px;
                   6107:   background-color: $data_table_light;
                   6108: }
1.795     www      6109: 
1.579     raeburn  6110: table.LC_pick_box td.LC_oddrow_value {
                   6111:   text-align: left;
                   6112:   padding: 8px;
                   6113:   background-color: $data_table_light;
                   6114: }
1.795     www      6115: 
1.579     raeburn  6116: span.LC_helpform_receipt_cat {
                   6117:   font-weight: bold;
                   6118: }
1.795     www      6119: 
1.424     albertel 6120: table.LC_group_priv_box {
                   6121:   background: white;
                   6122:   border: 1px solid black;
                   6123:   border-spacing: 1px;
                   6124: }
1.795     www      6125: 
1.424     albertel 6126: table.LC_group_priv_box td.LC_pick_box_title {
                   6127:   background: $tabbg;
                   6128:   font-weight: bold;
                   6129:   text-align: right;
                   6130:   width: 184px;
                   6131: }
1.795     www      6132: 
1.424     albertel 6133: table.LC_group_priv_box td.LC_groups_fixed {
                   6134:   background: $data_table_light;
                   6135:   text-align: center;
                   6136: }
1.795     www      6137: 
1.424     albertel 6138: table.LC_group_priv_box td.LC_groups_optional {
                   6139:   background: $data_table_dark;
                   6140:   text-align: center;
                   6141: }
1.795     www      6142: 
1.424     albertel 6143: table.LC_group_priv_box td.LC_groups_functionality {
                   6144:   background: $data_table_darker;
                   6145:   text-align: center;
                   6146:   font-weight: bold;
                   6147: }
1.795     www      6148: 
1.424     albertel 6149: table.LC_group_priv td {
                   6150:   text-align: left;
1.803     bisitz   6151:   padding: 0;
1.424     albertel 6152: }
                   6153: 
                   6154: .LC_navbuttons {
                   6155:   margin: 2ex 0ex 2ex 0ex;
                   6156: }
1.795     www      6157: 
1.423     albertel 6158: .LC_topic_bar {
                   6159:   font-weight: bold;
                   6160:   background: $tabbg;
1.918     wenzelju 6161:   margin: 1em 0em 1em 2em;
1.805     bisitz   6162:   padding: 3px;
1.918     wenzelju 6163:   font-size: 1.2em;
1.423     albertel 6164: }
1.795     www      6165: 
1.423     albertel 6166: .LC_topic_bar span {
1.918     wenzelju 6167:   left: 0.5em;
                   6168:   position: absolute;
1.423     albertel 6169:   vertical-align: middle;
1.918     wenzelju 6170:   font-size: 1.2em;
1.423     albertel 6171: }
1.795     www      6172: 
1.423     albertel 6173: table.LC_course_group_status {
                   6174:   margin: 20px;
                   6175: }
1.795     www      6176: 
1.423     albertel 6177: table.LC_status_selector td {
                   6178:   vertical-align: top;
                   6179:   text-align: center;
1.424     albertel 6180:   padding: 4px;
                   6181: }
1.795     www      6182: 
1.599     albertel 6183: div.LC_feedback_link {
1.616     albertel 6184:   clear: both;
1.829     kalberla 6185:   background: $sidebg;
1.779     bisitz   6186:   width: 100%;
1.829     kalberla 6187:   padding-bottom: 10px;
                   6188:   border: 1px $tabbg solid;
1.833     kalberla 6189:   height: 22px;
                   6190:   line-height: 22px;
                   6191:   padding-top: 5px;
                   6192: }
                   6193: 
                   6194: div.LC_feedback_link img {
                   6195:   height: 22px;
1.867     kalberla 6196:   vertical-align:middle;
1.829     kalberla 6197: }
                   6198: 
1.911     bisitz   6199: div.LC_feedback_link a {
1.829     kalberla 6200:   text-decoration: none;
1.489     raeburn  6201: }
1.795     www      6202: 
1.867     kalberla 6203: div.LC_comblock {
1.911     bisitz   6204:   display:inline;
1.867     kalberla 6205:   color:$font;
                   6206:   font-size:90%;
                   6207: }
                   6208: 
                   6209: div.LC_feedback_link div.LC_comblock {
                   6210:   padding-left:5px;
                   6211: }
                   6212: 
                   6213: div.LC_feedback_link div.LC_comblock a {
                   6214:   color:$font;
                   6215: }
                   6216: 
1.489     raeburn  6217: span.LC_feedback_link {
1.858     bisitz   6218:   /* background: $feedback_link_bg; */
1.599     albertel 6219:   font-size: larger;
                   6220: }
1.795     www      6221: 
1.599     albertel 6222: span.LC_message_link {
1.858     bisitz   6223:   /* background: $feedback_link_bg; */
1.599     albertel 6224:   font-size: larger;
                   6225:   position: absolute;
                   6226:   right: 1em;
1.489     raeburn  6227: }
1.421     albertel 6228: 
1.515     albertel 6229: table.LC_prior_tries {
1.524     albertel 6230:   border: 1px solid #000000;
                   6231:   border-collapse: separate;
                   6232:   border-spacing: 1px;
1.515     albertel 6233: }
1.523     albertel 6234: 
1.515     albertel 6235: table.LC_prior_tries td {
1.524     albertel 6236:   padding: 2px;
1.515     albertel 6237: }
1.523     albertel 6238: 
                   6239: .LC_answer_correct {
1.795     www      6240:   background: lightgreen;
                   6241:   color: darkgreen;
                   6242:   padding: 6px;
1.523     albertel 6243: }
1.795     www      6244: 
1.523     albertel 6245: .LC_answer_charged_try {
1.797     www      6246:   background: #FFAAAA;
1.795     www      6247:   color: darkred;
                   6248:   padding: 6px;
1.523     albertel 6249: }
1.795     www      6250: 
1.779     bisitz   6251: .LC_answer_not_charged_try,
1.523     albertel 6252: .LC_answer_no_grade,
                   6253: .LC_answer_late {
1.795     www      6254:   background: lightyellow;
1.523     albertel 6255:   color: black;
1.795     www      6256:   padding: 6px;
1.523     albertel 6257: }
1.795     www      6258: 
1.523     albertel 6259: .LC_answer_previous {
1.795     www      6260:   background: lightblue;
                   6261:   color: darkblue;
                   6262:   padding: 6px;
1.523     albertel 6263: }
1.795     www      6264: 
1.779     bisitz   6265: .LC_answer_no_message {
1.777     tempelho 6266:   background: #FFFFFF;
                   6267:   color: black;
1.795     www      6268:   padding: 6px;
1.779     bisitz   6269: }
1.795     www      6270: 
1.779     bisitz   6271: .LC_answer_unknown {
                   6272:   background: orange;
                   6273:   color: black;
1.795     www      6274:   padding: 6px;
1.777     tempelho 6275: }
1.795     www      6276: 
1.529     albertel 6277: span.LC_prior_numerical,
                   6278: span.LC_prior_string,
                   6279: span.LC_prior_custom,
                   6280: span.LC_prior_reaction,
                   6281: span.LC_prior_math {
1.925     bisitz   6282:   font-family: $mono;
1.523     albertel 6283:   white-space: pre;
                   6284: }
                   6285: 
1.525     albertel 6286: span.LC_prior_string {
1.925     bisitz   6287:   font-family: $mono;
1.525     albertel 6288:   white-space: pre;
                   6289: }
                   6290: 
1.523     albertel 6291: table.LC_prior_option {
                   6292:   width: 100%;
                   6293:   border-collapse: collapse;
                   6294: }
1.795     www      6295: 
1.911     bisitz   6296: table.LC_prior_rank,
1.795     www      6297: table.LC_prior_match {
1.528     albertel 6298:   border-collapse: collapse;
                   6299: }
1.795     www      6300: 
1.528     albertel 6301: table.LC_prior_option tr td,
                   6302: table.LC_prior_rank tr td,
                   6303: table.LC_prior_match tr td {
1.524     albertel 6304:   border: 1px solid #000000;
1.515     albertel 6305: }
                   6306: 
1.855     bisitz   6307: .LC_nobreak {
1.544     albertel 6308:   white-space: nowrap;
1.519     raeburn  6309: }
                   6310: 
1.576     raeburn  6311: span.LC_cusr_emph {
                   6312:   font-style: italic;
                   6313: }
                   6314: 
1.633     raeburn  6315: span.LC_cusr_subheading {
                   6316:   font-weight: normal;
                   6317:   font-size: 85%;
                   6318: }
                   6319: 
1.861     bisitz   6320: div.LC_docs_entry_move {
1.859     bisitz   6321:   border: 1px solid #BBBBBB;
1.545     albertel 6322:   background: #DDDDDD;
1.861     bisitz   6323:   width: 22px;
1.859     bisitz   6324:   padding: 1px;
                   6325:   margin: 0;
1.545     albertel 6326: }
                   6327: 
1.861     bisitz   6328: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6329: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6330:   font-size: x-small;
                   6331: }
1.795     www      6332: 
1.861     bisitz   6333: .LC_docs_entry_parameter {
                   6334:   white-space: nowrap;
                   6335: }
                   6336: 
1.544     albertel 6337: .LC_docs_copy {
1.545     albertel 6338:   color: #000099;
1.544     albertel 6339: }
1.795     www      6340: 
1.544     albertel 6341: .LC_docs_cut {
1.545     albertel 6342:   color: #550044;
1.544     albertel 6343: }
1.795     www      6344: 
1.544     albertel 6345: .LC_docs_rename {
1.545     albertel 6346:   color: #009900;
1.544     albertel 6347: }
1.795     www      6348: 
1.544     albertel 6349: .LC_docs_remove {
1.545     albertel 6350:   color: #990000;
                   6351: }
                   6352: 
1.547     albertel 6353: .LC_docs_reinit_warn,
                   6354: .LC_docs_ext_edit {
                   6355:   font-size: x-small;
                   6356: }
                   6357: 
1.545     albertel 6358: table.LC_docs_adddocs td,
                   6359: table.LC_docs_adddocs th {
                   6360:   border: 1px solid #BBBBBB;
                   6361:   padding: 4px;
                   6362:   background: #DDDDDD;
1.543     albertel 6363: }
                   6364: 
1.584     albertel 6365: table.LC_sty_begin {
                   6366:   background: #BBFFBB;
                   6367: }
1.795     www      6368: 
1.584     albertel 6369: table.LC_sty_end {
                   6370:   background: #FFBBBB;
                   6371: }
                   6372: 
1.589     raeburn  6373: table.LC_double_column {
1.803     bisitz   6374:   border-width: 0;
1.589     raeburn  6375:   border-collapse: collapse;
                   6376:   width: 100%;
                   6377:   padding: 2px;
                   6378: }
                   6379: 
                   6380: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6381:   top: 2px;
1.589     raeburn  6382:   left: 2px;
                   6383:   width: 47%;
                   6384:   vertical-align: top;
                   6385: }
                   6386: 
                   6387: table.LC_double_column tr td.LC_right_col {
                   6388:   top: 2px;
1.779     bisitz   6389:   right: 2px;
1.589     raeburn  6390:   width: 47%;
                   6391:   vertical-align: top;
                   6392: }
                   6393: 
1.591     raeburn  6394: div.LC_left_float {
                   6395:   float: left;
                   6396:   padding-right: 5%;
1.597     albertel 6397:   padding-bottom: 4px;
1.591     raeburn  6398: }
                   6399: 
                   6400: div.LC_clear_float_header {
1.597     albertel 6401:   padding-bottom: 2px;
1.591     raeburn  6402: }
                   6403: 
                   6404: div.LC_clear_float_footer {
1.597     albertel 6405:   padding-top: 10px;
1.591     raeburn  6406:   clear: both;
                   6407: }
                   6408: 
1.597     albertel 6409: div.LC_grade_show_user {
1.941     bisitz   6410: /*  border-left: 5px solid $sidebg; */
                   6411:   border-top: 5px solid #000000;
                   6412:   margin: 50px 0 0 0;
1.936     bisitz   6413:   padding: 15px 0 5px 10px;
1.597     albertel 6414: }
1.795     www      6415: 
1.936     bisitz   6416: div.LC_grade_show_user_odd_row {
1.941     bisitz   6417: /*  border-left: 5px solid #000000; */
                   6418: }
                   6419: 
                   6420: div.LC_grade_show_user div.LC_Box {
                   6421:   margin-right: 50px;
1.597     albertel 6422: }
                   6423: 
                   6424: div.LC_grade_submissions,
                   6425: div.LC_grade_message_center,
1.936     bisitz   6426: div.LC_grade_info_links {
1.597     albertel 6427:   margin: 5px;
                   6428:   width: 99%;
                   6429:   background: #FFFFFF;
                   6430: }
1.795     www      6431: 
1.597     albertel 6432: div.LC_grade_submissions_header,
1.936     bisitz   6433: div.LC_grade_message_center_header {
1.705     tempelho 6434:   font-weight: bold;
                   6435:   font-size: large;
1.597     albertel 6436: }
1.795     www      6437: 
1.597     albertel 6438: div.LC_grade_submissions_body,
1.936     bisitz   6439: div.LC_grade_message_center_body {
1.597     albertel 6440:   border: 1px solid black;
                   6441:   width: 99%;
                   6442:   background: #FFFFFF;
                   6443: }
1.795     www      6444: 
1.613     albertel 6445: table.LC_scantron_action {
                   6446:   width: 100%;
                   6447: }
1.795     www      6448: 
1.613     albertel 6449: table.LC_scantron_action tr th {
1.698     harmsja  6450:   font-weight:bold;
                   6451:   font-style:normal;
1.613     albertel 6452: }
1.795     www      6453: 
1.779     bisitz   6454: .LC_edit_problem_header,
1.614     albertel 6455: div.LC_edit_problem_footer {
1.705     tempelho 6456:   font-weight: normal;
                   6457:   font-size:  medium;
1.602     albertel 6458:   margin: 2px;
1.1060    bisitz   6459:   background-color: $sidebg;
1.600     albertel 6460: }
1.795     www      6461: 
1.600     albertel 6462: div.LC_edit_problem_header,
1.602     albertel 6463: div.LC_edit_problem_header div,
1.614     albertel 6464: div.LC_edit_problem_footer,
                   6465: div.LC_edit_problem_footer div,
1.602     albertel 6466: div.LC_edit_problem_editxml_header,
                   6467: div.LC_edit_problem_editxml_header div {
1.600     albertel 6468:   margin-top: 5px;
                   6469: }
1.795     www      6470: 
1.600     albertel 6471: div.LC_edit_problem_header_title {
1.705     tempelho 6472:   font-weight: bold;
                   6473:   font-size: larger;
1.602     albertel 6474:   background: $tabbg;
                   6475:   padding: 3px;
1.1060    bisitz   6476:   margin: 0 0 5px 0;
1.602     albertel 6477: }
1.795     www      6478: 
1.602     albertel 6479: table.LC_edit_problem_header_title {
                   6480:   width: 100%;
1.600     albertel 6481:   background: $tabbg;
1.602     albertel 6482: }
                   6483: 
                   6484: div.LC_edit_problem_discards {
                   6485:   float: left;
                   6486:   padding-bottom: 5px;
                   6487: }
1.795     www      6488: 
1.602     albertel 6489: div.LC_edit_problem_saves {
                   6490:   float: right;
                   6491:   padding-bottom: 5px;
1.600     albertel 6492: }
1.795     www      6493: 
1.1124    bisitz   6494: .LC_edit_opt {
                   6495:   padding-left: 1em;
                   6496:   white-space: nowrap;
                   6497: }
                   6498: 
1.1152  ! golterma 6499: .LC_edit_problem_latexhelper{
        !          6500:     text-align: right;
        !          6501: }
        !          6502: 
        !          6503: #LC_edit_problem_colorful div{
        !          6504:     margin-left: 40px;
        !          6505: }
        !          6506: 
1.911     bisitz   6507: img.stift {
1.803     bisitz   6508:   border-width: 0;
                   6509:   vertical-align: middle;
1.677     riegler  6510: }
1.680     riegler  6511: 
1.923     bisitz   6512: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6513:   vertical-align: top;
1.777     tempelho 6514: }
1.795     www      6515: 
1.716     raeburn  6516: div.LC_createcourse {
1.911     bisitz   6517:   margin: 10px 10px 10px 10px;
1.716     raeburn  6518: }
                   6519: 
1.917     raeburn  6520: .LC_dccid {
1.1130    raeburn  6521:   float: right;
1.917     raeburn  6522:   margin: 0.2em 0 0 0;
                   6523:   padding: 0;
                   6524:   font-size: 90%;
                   6525:   display:none;
                   6526: }
                   6527: 
1.897     wenzelju 6528: ol.LC_primary_menu a:hover,
1.721     harmsja  6529: ol#LC_MenuBreadcrumbs a:hover,
                   6530: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6531: ul#LC_secondary_menu a:hover,
1.721     harmsja  6532: .LC_FormSectionClearButton input:hover
1.795     www      6533: ul.LC_TabContent   li:hover a {
1.952     onken    6534:   color:$button_hover;
1.911     bisitz   6535:   text-decoration:none;
1.693     droeschl 6536: }
                   6537: 
1.779     bisitz   6538: h1 {
1.911     bisitz   6539:   padding: 0;
                   6540:   line-height:130%;
1.693     droeschl 6541: }
1.698     harmsja  6542: 
1.911     bisitz   6543: h2,
                   6544: h3,
                   6545: h4,
                   6546: h5,
                   6547: h6 {
                   6548:   margin: 5px 0 5px 0;
                   6549:   padding: 0;
                   6550:   line-height:130%;
1.693     droeschl 6551: }
1.795     www      6552: 
                   6553: .LC_hcell {
1.911     bisitz   6554:   padding:3px 15px 3px 15px;
                   6555:   margin: 0;
                   6556:   background-color:$tabbg;
                   6557:   color:$fontmenu;
                   6558:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6559: }
1.795     www      6560: 
1.840     bisitz   6561: .LC_Box > .LC_hcell {
1.911     bisitz   6562:   margin: 0 -10px 10px -10px;
1.835     bisitz   6563: }
                   6564: 
1.721     harmsja  6565: .LC_noBorder {
1.911     bisitz   6566:   border: 0;
1.698     harmsja  6567: }
1.693     droeschl 6568: 
1.721     harmsja  6569: .LC_FormSectionClearButton input {
1.911     bisitz   6570:   background-color:transparent;
                   6571:   border: none;
                   6572:   cursor:pointer;
                   6573:   text-decoration:underline;
1.693     droeschl 6574: }
1.763     bisitz   6575: 
                   6576: .LC_help_open_topic {
1.911     bisitz   6577:   color: #FFFFFF;
                   6578:   background-color: #EEEEFF;
                   6579:   margin: 1px;
                   6580:   padding: 4px;
                   6581:   border: 1px solid #000033;
                   6582:   white-space: nowrap;
                   6583:   /* vertical-align: middle; */
1.759     neumanie 6584: }
1.693     droeschl 6585: 
1.911     bisitz   6586: dl,
                   6587: ul,
                   6588: div,
                   6589: fieldset {
                   6590:   margin: 10px 10px 10px 0;
                   6591:   /* overflow: hidden; */
1.693     droeschl 6592: }
1.795     www      6593: 
1.838     bisitz   6594: fieldset > legend {
1.911     bisitz   6595:   font-weight: bold;
                   6596:   padding: 0 5px 0 5px;
1.838     bisitz   6597: }
                   6598: 
1.813     bisitz   6599: #LC_nav_bar {
1.911     bisitz   6600:   float: left;
1.995     raeburn  6601:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6602:   margin: 0 0 2px 0;
1.807     droeschl 6603: }
                   6604: 
1.916     droeschl 6605: #LC_realm {
                   6606:   margin: 0.2em 0 0 0;
                   6607:   padding: 0;
                   6608:   font-weight: bold;
                   6609:   text-align: center;
1.995     raeburn  6610:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6611: }
                   6612: 
1.911     bisitz   6613: #LC_nav_bar em {
                   6614:   font-weight: bold;
                   6615:   font-style: normal;
1.807     droeschl 6616: }
                   6617: 
1.897     wenzelju 6618: ol.LC_primary_menu {
1.934     droeschl 6619:   margin: 0;
1.1076    raeburn  6620:   padding: 0;
1.995     raeburn  6621:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6622: }
                   6623: 
1.852     droeschl 6624: ol#LC_PathBreadcrumbs {
1.911     bisitz   6625:   margin: 0;
1.693     droeschl 6626: }
                   6627: 
1.897     wenzelju 6628: ol.LC_primary_menu li {
1.1076    raeburn  6629:   color: RGB(80, 80, 80);
                   6630:   vertical-align: middle;
                   6631:   text-align: left;
                   6632:   list-style: none;
                   6633:   float: left;
                   6634: }
                   6635: 
                   6636: ol.LC_primary_menu li a {
                   6637:   display: block;
                   6638:   margin: 0;
                   6639:   padding: 0 5px 0 10px;
                   6640:   text-decoration: none;
                   6641: }
                   6642: 
                   6643: ol.LC_primary_menu li ul {
                   6644:   display: none;
                   6645:   width: 10em;
                   6646:   background-color: $data_table_light;
                   6647: }
                   6648: 
                   6649: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6650:   display: block;
                   6651:   position: absolute;
                   6652:   margin: 0;
                   6653:   padding: 0;
1.1078    raeburn  6654:   z-index: 2;
1.1076    raeburn  6655: }
                   6656: 
                   6657: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6658:   font-size: 90%;
1.911     bisitz   6659:   vertical-align: top;
1.1076    raeburn  6660:   float: none;
1.1079    raeburn  6661:   border-left: 1px solid black;
                   6662:   border-right: 1px solid black;
1.1076    raeburn  6663: }
                   6664: 
                   6665: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1078    raeburn  6666:   background-color:$data_table_light;
1.1076    raeburn  6667: }
                   6668: 
                   6669: ol.LC_primary_menu li li a:hover {
                   6670:    color:$button_hover;
                   6671:    background-color:$data_table_dark;
1.693     droeschl 6672: }
                   6673: 
1.897     wenzelju 6674: ol.LC_primary_menu li img {
1.911     bisitz   6675:   vertical-align: bottom;
1.934     droeschl 6676:   height: 1.1em;
1.1077    raeburn  6677:   margin: 0.2em 0 0 0;
1.693     droeschl 6678: }
                   6679: 
1.897     wenzelju 6680: ol.LC_primary_menu a {
1.911     bisitz   6681:   color: RGB(80, 80, 80);
                   6682:   text-decoration: none;
1.693     droeschl 6683: }
1.795     www      6684: 
1.949     droeschl 6685: ol.LC_primary_menu a.LC_new_message {
                   6686:   font-weight:bold;
                   6687:   color: darkred;
                   6688: }
                   6689: 
1.975     raeburn  6690: ol.LC_docs_parameters {
                   6691:   margin-left: 0;
                   6692:   padding: 0;
                   6693:   list-style: none;
                   6694: }
                   6695: 
                   6696: ol.LC_docs_parameters li {
                   6697:   margin: 0;
                   6698:   padding-right: 20px;
                   6699:   display: inline;
                   6700: }
                   6701: 
1.976     raeburn  6702: ol.LC_docs_parameters li:before {
                   6703:   content: "\\002022 \\0020";
                   6704: }
                   6705: 
                   6706: li.LC_docs_parameters_title {
                   6707:   font-weight: bold;
                   6708: }
                   6709: 
                   6710: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6711:   content: "";
                   6712: }
                   6713: 
1.897     wenzelju 6714: ul#LC_secondary_menu {
1.1107    raeburn  6715:   clear: right;
1.911     bisitz   6716:   color: $fontmenu;
                   6717:   background: $tabbg;
                   6718:   list-style: none;
                   6719:   padding: 0;
                   6720:   margin: 0;
                   6721:   width: 100%;
1.995     raeburn  6722:   text-align: left;
1.1107    raeburn  6723:   float: left;
1.808     droeschl 6724: }
                   6725: 
1.897     wenzelju 6726: ul#LC_secondary_menu li {
1.911     bisitz   6727:   font-weight: bold;
                   6728:   line-height: 1.8em;
1.1107    raeburn  6729:   border-right: 1px solid black;
                   6730:   float: left;
                   6731: }
                   6732: 
                   6733: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6734:   background-color: $data_table_light;
                   6735: }
                   6736: 
                   6737: ul#LC_secondary_menu li a {
1.911     bisitz   6738:   padding: 0 0.8em;
1.1107    raeburn  6739: }
                   6740: 
                   6741: ul#LC_secondary_menu li ul {
                   6742:   display: none;
                   6743: }
                   6744: 
                   6745: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6746:   display: block;
                   6747:   position: absolute;
                   6748:   margin: 0;
                   6749:   padding: 0;
                   6750:   list-style:none;
                   6751:   float: none;
                   6752:   background-color: $data_table_light;
                   6753:   z-index: 2;
                   6754:   margin-left: -1px;
                   6755: }
                   6756: 
                   6757: ul#LC_secondary_menu li ul li {
                   6758:   font-size: 90%;
                   6759:   vertical-align: top;
                   6760:   border-left: 1px solid black;
1.911     bisitz   6761:   border-right: 1px solid black;
1.1119    raeburn  6762:   background-color: $data_table_light;
1.1107    raeburn  6763:   list-style:none;
                   6764:   float: none;
                   6765: }
                   6766: 
                   6767: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6768:   background-color: $data_table_dark;
1.807     droeschl 6769: }
                   6770: 
1.847     tempelho 6771: ul.LC_TabContent {
1.911     bisitz   6772:   display:block;
                   6773:   background: $sidebg;
                   6774:   border-bottom: solid 1px $lg_border_color;
                   6775:   list-style:none;
1.1020    raeburn  6776:   margin: -1px -10px 0 -10px;
1.911     bisitz   6777:   padding: 0;
1.693     droeschl 6778: }
                   6779: 
1.795     www      6780: ul.LC_TabContent li,
                   6781: ul.LC_TabContentBigger li {
1.911     bisitz   6782:   float:left;
1.741     harmsja  6783: }
1.795     www      6784: 
1.897     wenzelju 6785: ul#LC_secondary_menu li a {
1.911     bisitz   6786:   color: $fontmenu;
                   6787:   text-decoration: none;
1.693     droeschl 6788: }
1.795     www      6789: 
1.721     harmsja  6790: ul.LC_TabContent {
1.952     onken    6791:   min-height:20px;
1.721     harmsja  6792: }
1.795     www      6793: 
                   6794: ul.LC_TabContent li {
1.911     bisitz   6795:   vertical-align:middle;
1.959     onken    6796:   padding: 0 16px 0 10px;
1.911     bisitz   6797:   background-color:$tabbg;
                   6798:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6799:   border-left: solid 1px $font;
1.721     harmsja  6800: }
1.795     www      6801: 
1.847     tempelho 6802: ul.LC_TabContent .right {
1.911     bisitz   6803:   float:right;
1.847     tempelho 6804: }
                   6805: 
1.911     bisitz   6806: ul.LC_TabContent li a,
                   6807: ul.LC_TabContent li {
                   6808:   color:rgb(47,47,47);
                   6809:   text-decoration:none;
                   6810:   font-size:95%;
                   6811:   font-weight:bold;
1.952     onken    6812:   min-height:20px;
                   6813: }
                   6814: 
1.959     onken    6815: ul.LC_TabContent li a:hover,
                   6816: ul.LC_TabContent li a:focus {
1.952     onken    6817:   color: $button_hover;
1.959     onken    6818:   background:none;
                   6819:   outline:none;
1.952     onken    6820: }
                   6821: 
                   6822: ul.LC_TabContent li:hover {
                   6823:   color: $button_hover;
                   6824:   cursor:pointer;
1.721     harmsja  6825: }
1.795     www      6826: 
1.911     bisitz   6827: ul.LC_TabContent li.active {
1.952     onken    6828:   color: $font;
1.911     bisitz   6829:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6830:   border-bottom:solid 1px #FFFFFF;
                   6831:   cursor: default;
1.744     ehlerst  6832: }
1.795     www      6833: 
1.959     onken    6834: ul.LC_TabContent li.active a {
                   6835:   color:$font;
                   6836:   background:#FFFFFF;
                   6837:   outline: none;
                   6838: }
1.1047    raeburn  6839: 
                   6840: ul.LC_TabContent li.goback {
                   6841:   float: left;
                   6842:   border-left: none;
                   6843: }
                   6844: 
1.870     tempelho 6845: #maincoursedoc {
1.911     bisitz   6846:   clear:both;
1.870     tempelho 6847: }
                   6848: 
                   6849: ul.LC_TabContentBigger {
1.911     bisitz   6850:   display:block;
                   6851:   list-style:none;
                   6852:   padding: 0;
1.870     tempelho 6853: }
                   6854: 
1.795     www      6855: ul.LC_TabContentBigger li {
1.911     bisitz   6856:   vertical-align:bottom;
                   6857:   height: 30px;
                   6858:   font-size:110%;
                   6859:   font-weight:bold;
                   6860:   color: #737373;
1.841     tempelho 6861: }
                   6862: 
1.957     onken    6863: ul.LC_TabContentBigger li.active {
                   6864:   position: relative;
                   6865:   top: 1px;
                   6866: }
                   6867: 
1.870     tempelho 6868: ul.LC_TabContentBigger li a {
1.911     bisitz   6869:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6870:   height: 30px;
                   6871:   line-height: 30px;
                   6872:   text-align: center;
                   6873:   display: block;
                   6874:   text-decoration: none;
1.958     onken    6875:   outline: none;  
1.741     harmsja  6876: }
1.795     www      6877: 
1.870     tempelho 6878: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6879:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6880:   color:$font;
1.744     ehlerst  6881: }
1.795     www      6882: 
1.870     tempelho 6883: ul.LC_TabContentBigger li b {
1.911     bisitz   6884:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6885:   display: block;
                   6886:   float: left;
                   6887:   padding: 0 30px;
1.957     onken    6888:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6889: }
                   6890: 
1.956     onken    6891: ul.LC_TabContentBigger li:hover b {
                   6892:   color:$button_hover;
                   6893: }
                   6894: 
1.870     tempelho 6895: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6896:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6897:   color:$font;
1.957     onken    6898:   border: 0;
1.741     harmsja  6899: }
1.693     droeschl 6900: 
1.870     tempelho 6901: 
1.862     bisitz   6902: ul.LC_CourseBreadcrumbs {
                   6903:   background: $sidebg;
1.1020    raeburn  6904:   height: 2em;
1.862     bisitz   6905:   padding-left: 10px;
1.1020    raeburn  6906:   margin: 0;
1.862     bisitz   6907:   list-style-position: inside;
                   6908: }
                   6909: 
1.911     bisitz   6910: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6911: ol#LC_PathBreadcrumbs {
1.911     bisitz   6912:   padding-left: 10px;
                   6913:   margin: 0;
1.933     droeschl 6914:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6915: }
                   6916: 
1.911     bisitz   6917: ol#LC_MenuBreadcrumbs li,
                   6918: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6919: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6920:   display: inline;
1.933     droeschl 6921:   white-space: normal;  
1.693     droeschl 6922: }
                   6923: 
1.823     bisitz   6924: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6925: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6926:   text-decoration: none;
                   6927:   font-size:90%;
1.693     droeschl 6928: }
1.795     www      6929: 
1.969     droeschl 6930: ol#LC_MenuBreadcrumbs h1 {
                   6931:   display: inline;
                   6932:   font-size: 90%;
                   6933:   line-height: 2.5em;
                   6934:   margin: 0;
                   6935:   padding: 0;
                   6936: }
                   6937: 
1.795     www      6938: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6939:   text-decoration:none;
                   6940:   font-size:100%;
                   6941:   font-weight:bold;
1.693     droeschl 6942: }
1.795     www      6943: 
1.840     bisitz   6944: .LC_Box {
1.911     bisitz   6945:   border: solid 1px $lg_border_color;
                   6946:   padding: 0 10px 10px 10px;
1.746     neumanie 6947: }
1.795     www      6948: 
1.1020    raeburn  6949: .LC_DocsBox {
                   6950:   border: solid 1px $lg_border_color;
                   6951:   padding: 0 0 10px 10px;
                   6952: }
                   6953: 
1.795     www      6954: .LC_AboutMe_Image {
1.911     bisitz   6955:   float:left;
                   6956:   margin-right:10px;
1.747     neumanie 6957: }
1.795     www      6958: 
                   6959: .LC_Clear_AboutMe_Image {
1.911     bisitz   6960:   clear:left;
1.747     neumanie 6961: }
1.795     www      6962: 
1.721     harmsja  6963: dl.LC_ListStyleClean dt {
1.911     bisitz   6964:   padding-right: 5px;
                   6965:   display: table-header-group;
1.693     droeschl 6966: }
                   6967: 
1.721     harmsja  6968: dl.LC_ListStyleClean dd {
1.911     bisitz   6969:   display: table-row;
1.693     droeschl 6970: }
                   6971: 
1.721     harmsja  6972: .LC_ListStyleClean,
                   6973: .LC_ListStyleSimple,
                   6974: .LC_ListStyleNormal,
1.795     www      6975: .LC_ListStyleSpecial {
1.911     bisitz   6976:   /* display:block; */
                   6977:   list-style-position: inside;
                   6978:   list-style-type: none;
                   6979:   overflow: hidden;
                   6980:   padding: 0;
1.693     droeschl 6981: }
                   6982: 
1.721     harmsja  6983: .LC_ListStyleSimple li,
                   6984: .LC_ListStyleSimple dd,
                   6985: .LC_ListStyleNormal li,
                   6986: .LC_ListStyleNormal dd,
                   6987: .LC_ListStyleSpecial li,
1.795     www      6988: .LC_ListStyleSpecial dd {
1.911     bisitz   6989:   margin: 0;
                   6990:   padding: 5px 5px 5px 10px;
                   6991:   clear: both;
1.693     droeschl 6992: }
                   6993: 
1.721     harmsja  6994: .LC_ListStyleClean li,
                   6995: .LC_ListStyleClean dd {
1.911     bisitz   6996:   padding-top: 0;
                   6997:   padding-bottom: 0;
1.693     droeschl 6998: }
                   6999: 
1.721     harmsja  7000: .LC_ListStyleSimple dd,
1.795     www      7001: .LC_ListStyleSimple li {
1.911     bisitz   7002:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7003: }
                   7004: 
1.721     harmsja  7005: .LC_ListStyleSpecial li,
                   7006: .LC_ListStyleSpecial dd {
1.911     bisitz   7007:   list-style-type: none;
                   7008:   background-color: RGB(220, 220, 220);
                   7009:   margin-bottom: 4px;
1.693     droeschl 7010: }
                   7011: 
1.721     harmsja  7012: table.LC_SimpleTable {
1.911     bisitz   7013:   margin:5px;
                   7014:   border:solid 1px $lg_border_color;
1.795     www      7015: }
1.693     droeschl 7016: 
1.721     harmsja  7017: table.LC_SimpleTable tr {
1.911     bisitz   7018:   padding: 0;
                   7019:   border:solid 1px $lg_border_color;
1.693     droeschl 7020: }
1.795     www      7021: 
                   7022: table.LC_SimpleTable thead {
1.911     bisitz   7023:   background:rgb(220,220,220);
1.693     droeschl 7024: }
                   7025: 
1.721     harmsja  7026: div.LC_columnSection {
1.911     bisitz   7027:   display: block;
                   7028:   clear: both;
                   7029:   overflow: hidden;
                   7030:   margin: 0;
1.693     droeschl 7031: }
                   7032: 
1.721     harmsja  7033: div.LC_columnSection>* {
1.911     bisitz   7034:   float: left;
                   7035:   margin: 10px 20px 10px 0;
                   7036:   overflow:hidden;
1.693     droeschl 7037: }
1.721     harmsja  7038: 
1.795     www      7039: table em {
1.911     bisitz   7040:   font-weight: bold;
                   7041:   font-style: normal;
1.748     schulted 7042: }
1.795     www      7043: 
1.779     bisitz   7044: table.LC_tableBrowseRes,
1.795     www      7045: table.LC_tableOfContent {
1.911     bisitz   7046:   border:none;
                   7047:   border-spacing: 1px;
                   7048:   padding: 3px;
                   7049:   background-color: #FFFFFF;
                   7050:   font-size: 90%;
1.753     droeschl 7051: }
1.789     droeschl 7052: 
1.911     bisitz   7053: table.LC_tableOfContent {
                   7054:   border-collapse: collapse;
1.789     droeschl 7055: }
                   7056: 
1.771     droeschl 7057: table.LC_tableBrowseRes a,
1.768     schulted 7058: table.LC_tableOfContent a {
1.911     bisitz   7059:   background-color: transparent;
                   7060:   text-decoration: none;
1.753     droeschl 7061: }
                   7062: 
1.795     www      7063: table.LC_tableOfContent img {
1.911     bisitz   7064:   border: none;
                   7065:   height: 1.3em;
                   7066:   vertical-align: text-bottom;
                   7067:   margin-right: 0.3em;
1.753     droeschl 7068: }
1.757     schulted 7069: 
1.795     www      7070: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7071:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7072: }
                   7073: 
1.795     www      7074: a#LC_content_toolbar_everything {
1.911     bisitz   7075:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7076: }
                   7077: 
1.795     www      7078: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7079:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7080: }
                   7081: 
1.795     www      7082: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7083:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7084: }
                   7085: 
1.795     www      7086: a#LC_content_toolbar_changefolder {
1.911     bisitz   7087:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7088: }
                   7089: 
1.795     www      7090: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7091:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7092: }
                   7093: 
1.1043    raeburn  7094: a#LC_content_toolbar_edittoplevel {
                   7095:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7096: }
                   7097: 
1.795     www      7098: ul#LC_toolbar li a:hover {
1.911     bisitz   7099:   background-position: bottom center;
1.757     schulted 7100: }
                   7101: 
1.795     www      7102: ul#LC_toolbar {
1.911     bisitz   7103:   padding: 0;
                   7104:   margin: 2px;
                   7105:   list-style:none;
                   7106:   position:relative;
                   7107:   background-color:white;
1.1082    raeburn  7108:   overflow: auto;
1.757     schulted 7109: }
                   7110: 
1.795     www      7111: ul#LC_toolbar li {
1.911     bisitz   7112:   border:1px solid white;
                   7113:   padding: 0;
                   7114:   margin: 0;
                   7115:   float: left;
                   7116:   display:inline;
                   7117:   vertical-align:middle;
1.1082    raeburn  7118:   white-space: nowrap;
1.911     bisitz   7119: }
1.757     schulted 7120: 
1.783     amueller 7121: 
1.795     www      7122: a.LC_toolbarItem {
1.911     bisitz   7123:   display:block;
                   7124:   padding: 0;
                   7125:   margin: 0;
                   7126:   height: 32px;
                   7127:   width: 32px;
                   7128:   color:white;
                   7129:   border: none;
                   7130:   background-repeat:no-repeat;
                   7131:   background-color:transparent;
1.757     schulted 7132: }
                   7133: 
1.915     droeschl 7134: ul.LC_funclist {
                   7135:     margin: 0;
                   7136:     padding: 0.5em 1em 0.5em 0;
                   7137: }
                   7138: 
1.933     droeschl 7139: ul.LC_funclist > li:first-child {
                   7140:     font-weight:bold; 
                   7141:     margin-left:0.8em;
                   7142: }
                   7143: 
1.915     droeschl 7144: ul.LC_funclist + ul.LC_funclist {
                   7145:     /* 
                   7146:        left border as a seperator if we have more than
                   7147:        one list 
                   7148:     */
                   7149:     border-left: 1px solid $sidebg;
                   7150:     /* 
                   7151:        this hides the left border behind the border of the 
                   7152:        outer box if element is wrapped to the next 'line' 
                   7153:     */
                   7154:     margin-left: -1px;
                   7155: }
                   7156: 
1.843     bisitz   7157: ul.LC_funclist li {
1.915     droeschl 7158:   display: inline;
1.782     bisitz   7159:   white-space: nowrap;
1.915     droeschl 7160:   margin: 0 0 0 25px;
                   7161:   line-height: 150%;
1.782     bisitz   7162: }
                   7163: 
1.974     wenzelju 7164: .LC_hidden {
                   7165:   display: none;
                   7166: }
                   7167: 
1.1030    www      7168: .LCmodal-overlay {
                   7169: 		position:fixed;
                   7170: 		top:0;
                   7171: 		right:0;
                   7172: 		bottom:0;
                   7173: 		left:0;
                   7174: 		height:100%;
                   7175: 		width:100%;
                   7176: 		margin:0;
                   7177: 		padding:0;
                   7178: 		background:#999;
                   7179: 		opacity:.75;
                   7180: 		filter: alpha(opacity=75);
                   7181: 		-moz-opacity: 0.75;
                   7182: 		z-index:101;
                   7183: }
                   7184: 
                   7185: * html .LCmodal-overlay {   
                   7186: 		position: absolute;
                   7187: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7188: }
                   7189: 
                   7190: .LCmodal-window {
                   7191: 		position:fixed;
                   7192: 		top:50%;
                   7193: 		left:50%;
                   7194: 		margin:0;
                   7195: 		padding:0;
                   7196: 		z-index:102;
                   7197: 	}
                   7198: 
                   7199: * html .LCmodal-window {
                   7200: 		position:absolute;
                   7201: }
                   7202: 
                   7203: .LCclose-window {
                   7204: 		position:absolute;
                   7205: 		width:32px;
                   7206: 		height:32px;
                   7207: 		right:8px;
                   7208: 		top:8px;
                   7209: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7210: 		text-indent:-99999px;
                   7211: 		overflow:hidden;
                   7212: 		cursor:pointer;
                   7213: }
                   7214: 
1.1100    raeburn  7215: /*
                   7216:   styles used by TTH when "Default set of options to pass to tth/m
                   7217:   when converting TeX" in course settings has been set
                   7218: 
                   7219:   option passed: -t
                   7220: 
                   7221: */
                   7222: 
                   7223: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7224: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7225: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7226: td div.norm {line-height:normal;}
                   7227: 
                   7228: /*
                   7229:   option passed -y3
                   7230: */
                   7231: 
                   7232: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7233: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7234: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7235: 
1.343     albertel 7236: END
                   7237: }
                   7238: 
1.306     albertel 7239: =pod
                   7240: 
                   7241: =item * &headtag()
                   7242: 
                   7243: Returns a uniform footer for LON-CAPA web pages.
                   7244: 
1.307     albertel 7245: Inputs: $title - optional title for the head
                   7246:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7247:         $args - optional arguments
1.319     albertel 7248:             force_register - if is true call registerurl so the remote is 
                   7249:                              informed
1.415     albertel 7250:             redirect       -> array ref of
                   7251:                                    1- seconds before redirect occurs
                   7252:                                    2- url to redirect to
                   7253:                                    3- whether the side effect should occur
1.315     albertel 7254:                            (side effect of setting 
                   7255:                                $env{'internal.head.redirect'} to the url 
                   7256:                                redirected too)
1.352     albertel 7257:             domain         -> force to color decorate a page for a specific
                   7258:                                domain
                   7259:             function       -> force usage of a specific rolish color scheme
                   7260:             bgcolor        -> override the default page bgcolor
1.460     albertel 7261:             no_auto_mt_title
                   7262:                            -> prevent &mt()ing the title arg
1.464     albertel 7263: 
1.306     albertel 7264: =cut
                   7265: 
                   7266: sub headtag {
1.313     albertel 7267:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7268:     
1.363     albertel 7269:     my $function = $args->{'function'} || &get_users_function();
                   7270:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7271:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.418     albertel 7272:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7273: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7274: 		   #time(),
1.418     albertel 7275: 		   $env{'environment.color.timestamp'},
1.363     albertel 7276: 		   $function,$domain,$bgcolor);
                   7277: 
1.369     www      7278:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7279: 
1.308     albertel 7280:     my $result =
                   7281: 	'<head>'.
1.461     albertel 7282: 	&font_settings();
1.319     albertel 7283: 
1.1064    raeburn  7284:     my $inhibitprint = &print_suppression();
                   7285: 
1.461     albertel 7286:     if (!$args->{'frameset'}) {
                   7287: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7288:     }
1.962     droeschl 7289:     if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
                   7290:         $result .= Apache::lonxml::display_title();
1.319     albertel 7291:     }
1.436     albertel 7292:     if (!$args->{'no_nav_bar'} 
                   7293: 	&& !$args->{'only_body'}
                   7294: 	&& !$args->{'frameset'}) {
                   7295: 	$result .= &help_menu_js();
1.1032    www      7296:         $result.=&modal_window();
1.1038    www      7297:         $result.=&togglebox_script();
1.1034    www      7298:         $result.=&wishlist_window();
1.1041    www      7299:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7300:     } else {
                   7301:         if ($args->{'add_modal'}) {
                   7302:            $result.=&modal_window();
                   7303:         }
                   7304:         if ($args->{'add_wishlist'}) {
                   7305:            $result.=&wishlist_window();
                   7306:         }
1.1038    www      7307:         if ($args->{'add_togglebox'}) {
                   7308:            $result.=&togglebox_script();
                   7309:         }
1.1041    www      7310:         if ($args->{'add_progressbar'}) {
                   7311:            $result.=&LCprogressbarUpdate_script();
                   7312:         }
1.436     albertel 7313:     }
1.314     albertel 7314:     if (ref($args->{'redirect'})) {
1.414     albertel 7315: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7316: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7317: 	if (!$inhibit_continue) {
                   7318: 	    $env{'internal.head.redirect'} = $url;
                   7319: 	}
1.313     albertel 7320: 	$result.=<<ADDMETA
                   7321: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7322: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7323: ADDMETA
                   7324:     }
1.306     albertel 7325:     if (!defined($title)) {
                   7326: 	$title = 'The LearningOnline Network with CAPA';
                   7327:     }
1.460     albertel 7328:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7329:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.414     albertel 7330: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'" />'
1.1064    raeburn  7331:         .$inhibitprint
1.414     albertel 7332: 	.$head_extra;
1.1137    raeburn  7333:     if ($env{'browser.mobile'}) {
                   7334:         $result .= '
                   7335: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7336: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7337:     }
1.962     droeschl 7338:     return $result.'</head>';
1.306     albertel 7339: }
                   7340: 
                   7341: =pod
                   7342: 
1.340     albertel 7343: =item * &font_settings()
                   7344: 
                   7345: Returns neccessary <meta> to set the proper encoding
                   7346: 
                   7347: Inputs: none
                   7348: 
                   7349: =cut
                   7350: 
                   7351: sub font_settings {
                   7352:     my $headerstring='';
1.647     www      7353:     if (!$env{'browser.mathml'} && $env{'browser.unicode'}) {
1.340     albertel 7354: 	$headerstring.=
                   7355: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />';
                   7356:     }
                   7357:     return $headerstring;
                   7358: }
                   7359: 
1.341     albertel 7360: =pod
                   7361: 
1.1064    raeburn  7362: =item * &print_suppression()
                   7363: 
                   7364: In course context returns css which causes the body to be blank when media="print",
                   7365: if printout generation is unavailable for the current resource.
                   7366: 
                   7367: This could be because:
                   7368: 
                   7369: (a) printstartdate is in the future
                   7370: 
                   7371: (b) printenddate is in the past
                   7372: 
                   7373: (c) there is an active exam block with "printout"
                   7374: functionality blocked
                   7375: 
                   7376: Users with pav, pfo or evb privileges are exempt.
                   7377: 
                   7378: Inputs: none
                   7379: 
                   7380: =cut
                   7381: 
                   7382: 
                   7383: sub print_suppression {
                   7384:     my $noprint;
                   7385:     if ($env{'request.course.id'}) {
                   7386:         my $scope = $env{'request.course.id'};
                   7387:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7388:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7389:             return;
                   7390:         }
                   7391:         if ($env{'request.course.sec'} ne '') {
                   7392:             $scope .= "/$env{'request.course.sec'}";
                   7393:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7394:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7395:                 return;
1.1064    raeburn  7396:             }
                   7397:         }
                   7398:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7399:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7400:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7401:         if ($blocked) {
                   7402:             my $checkrole = "cm./$cdom/$cnum";
                   7403:             if ($env{'request.course.sec'} ne '') {
                   7404:                 $checkrole .= "/$env{'request.course.sec'}";
                   7405:             }
                   7406:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7407:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7408:                 $noprint = 1;
                   7409:             }
                   7410:         }
                   7411:         unless ($noprint) {
                   7412:             my $symb = &Apache::lonnet::symbread();
                   7413:             if ($symb ne '') {
                   7414:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7415:                 if (ref($navmap)) {
                   7416:                     my $res = $navmap->getBySymb($symb);
                   7417:                     if (ref($res)) {
                   7418:                         if (!$res->resprintable()) {
                   7419:                             $noprint = 1;
                   7420:                         }
                   7421:                     }
                   7422:                 }
                   7423:             }
                   7424:         }
                   7425:         if ($noprint) {
                   7426:             return <<"ENDSTYLE";
                   7427: <style type="text/css" media="print">
                   7428:     body { display:none }
                   7429: </style>
                   7430: ENDSTYLE
                   7431:         }
                   7432:     }
                   7433:     return;
                   7434: }
                   7435: 
                   7436: =pod
                   7437: 
1.341     albertel 7438: =item * &xml_begin()
                   7439: 
                   7440: Returns the needed doctype and <html>
                   7441: 
                   7442: Inputs: none
                   7443: 
                   7444: =cut
                   7445: 
                   7446: sub xml_begin {
                   7447:     my $output='';
                   7448: 
                   7449:     if ($env{'browser.mathml'}) {
                   7450: 	$output='<?xml version="1.0"?>'
                   7451:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7452: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7453:             
                   7454: #	    .'<!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">] >'
                   7455: 	    .'<!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">'
                   7456:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7457: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
                   7458:     } else {
1.849     bisitz   7459: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
                   7460:            .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">';
1.341     albertel 7461:     }
                   7462:     return $output;
                   7463: }
1.340     albertel 7464: 
                   7465: =pod
                   7466: 
1.306     albertel 7467: =item * &start_page()
                   7468: 
                   7469: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7470: 
1.648     raeburn  7471: Inputs:
                   7472: 
                   7473: =over 4
                   7474: 
                   7475: $title - optional title for the page
                   7476: 
                   7477: $head_extra - optional extra HTML to incude inside the <head>
                   7478: 
                   7479: $args - additional optional args supported are:
                   7480: 
                   7481: =over 8
                   7482: 
                   7483:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7484:                                     arg on
1.814     bisitz   7485:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7486:              add_entries    -> additional attributes to add to the  <body>
                   7487:              domain         -> force to color decorate a page for a 
1.317     albertel 7488:                                     specific domain
1.648     raeburn  7489:              function       -> force usage of a specific rolish color
1.317     albertel 7490:                                     scheme
1.648     raeburn  7491:              redirect       -> see &headtag()
                   7492:              bgcolor        -> override the default page bg color
                   7493:              js_ready       -> return a string ready for being used in 
1.317     albertel 7494:                                     a javascript writeln
1.648     raeburn  7495:              html_encode    -> return a string ready for being used in 
1.320     albertel 7496:                                     a html attribute
1.648     raeburn  7497:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7498:                                     $forcereg arg
1.648     raeburn  7499:              frameset       -> if true will start with a <frameset>
1.330     albertel 7500:                                     rather than <body>
1.648     raeburn  7501:              skip_phases    -> hash ref of 
1.338     albertel 7502:                                     head -> skip the <html><head> generation
                   7503:                                     body -> skip all <body> generation
1.648     raeburn  7504:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7505:              inherit_jsmath -> when creating popup window in a page,
                   7506:                                     should it have jsmath forced on by the
                   7507:                                     current page
1.867     kalberla 7508:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7509:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1096    raeburn  7510:              group          -> includes the current group, if page is for a 
                   7511:                                specific group  
1.361     albertel 7512: 
1.648     raeburn  7513: =back
1.460     albertel 7514: 
1.648     raeburn  7515: =back
1.562     albertel 7516: 
1.306     albertel 7517: =cut
                   7518: 
                   7519: sub start_page {
1.309     albertel 7520:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7521:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7522: 
1.315     albertel 7523:     $env{'internal.start_page'}++;
1.1096    raeburn  7524:     my ($result,@advtools);
1.964     droeschl 7525: 
1.338     albertel 7526:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1030    www      7527:         $result .= &xml_begin() . &headtag($title, $head_extra, $args);
1.338     albertel 7528:     }
                   7529:     
                   7530:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7531: 	if ($args->{'frameset'}) {
                   7532: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7533: 						$args->{'add_entries'});
                   7534: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7535:         } else {
                   7536:             $result .=
                   7537:                 &bodytag($title, 
                   7538:                          $args->{'function'},       $args->{'add_entries'},
                   7539:                          $args->{'only_body'},      $args->{'domain'},
                   7540:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096    raeburn  7541:                          $args->{'bgcolor'},        $args,
                   7542:                          \@advtools);
1.831     bisitz   7543:         }
1.330     albertel 7544:     }
1.338     albertel 7545: 
1.315     albertel 7546:     if ($args->{'js_ready'}) {
1.713     kaisler  7547: 		$result = &js_ready($result);
1.315     albertel 7548:     }
1.320     albertel 7549:     if ($args->{'html_encode'}) {
1.713     kaisler  7550: 		$result = &html_encode($result);
                   7551:     }
                   7552: 
1.813     bisitz   7553:     # Preparation for new and consistent functionlist at top of screen
                   7554:     # if ($args->{'functionlist'}) {
                   7555:     #            $result .= &build_functionlist();
                   7556:     #}
                   7557: 
1.964     droeschl 7558:     # Don't add anything more if only_body wanted or in const space
                   7559:     return $result if    $args->{'only_body'} 
                   7560:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7561: 
                   7562:     #Breadcrumbs
1.758     kaisler  7563:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7564: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7565: 		#if any br links exists, add them to the breadcrumbs
                   7566: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7567: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7568: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7569: 			}
                   7570: 		}
1.1096    raeburn  7571:                 # if @advtools array contains items add then to the breadcrumbs
                   7572:                 if (@advtools > 0) {
                   7573:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7574:                 }
1.758     kaisler  7575: 
                   7576: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7577: 		if(exists($args->{'bread_crumbs_component'})){
                   7578: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7579: 		}else{
                   7580: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7581: 		}
1.320     albertel 7582:     }
1.315     albertel 7583:     return $result;
1.306     albertel 7584: }
                   7585: 
                   7586: sub end_page {
1.315     albertel 7587:     my ($args) = @_;
                   7588:     $env{'internal.end_page'}++;
1.330     albertel 7589:     my $result;
1.335     albertel 7590:     if ($args->{'discussion'}) {
                   7591: 	my ($target,$parser);
                   7592: 	if (ref($args->{'discussion'})) {
                   7593: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7594: 				$args->{'discussion'}{'parser'});
                   7595: 	}
                   7596: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7597:     }
1.330     albertel 7598:     if ($args->{'frameset'}) {
                   7599: 	$result .= '</frameset>';
                   7600:     } else {
1.635     raeburn  7601: 	$result .= &endbodytag($args);
1.330     albertel 7602:     }
1.1080    raeburn  7603:     unless ($args->{'notbody'}) {
                   7604:         $result .= "\n</html>";
                   7605:     }
1.330     albertel 7606: 
1.315     albertel 7607:     if ($args->{'js_ready'}) {
1.317     albertel 7608: 	$result = &js_ready($result);
1.315     albertel 7609:     }
1.335     albertel 7610: 
1.320     albertel 7611:     if ($args->{'html_encode'}) {
                   7612: 	$result = &html_encode($result);
                   7613:     }
1.335     albertel 7614: 
1.315     albertel 7615:     return $result;
                   7616: }
                   7617: 
1.1034    www      7618: sub wishlist_window {
                   7619:     return(<<'ENDWISHLIST');
1.1046    raeburn  7620: <script type="text/javascript">
1.1034    www      7621: // <![CDATA[
                   7622: // <!-- BEGIN LON-CAPA Internal
                   7623: function set_wishlistlink(title, path) {
                   7624:     if (!title) {
                   7625:         title = document.title;
                   7626:         title = title.replace(/^LON-CAPA /,'');
                   7627:     }
                   7628:     if (!path) {
                   7629:         path = location.pathname;
                   7630:     }
                   7631:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7632:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7633: }
                   7634: // END LON-CAPA Internal -->
                   7635: // ]]>
                   7636: </script>
                   7637: ENDWISHLIST
                   7638: }
                   7639: 
1.1030    www      7640: sub modal_window {
                   7641:     return(<<'ENDMODAL');
1.1046    raeburn  7642: <script type="text/javascript">
1.1030    www      7643: // <![CDATA[
                   7644: // <!-- BEGIN LON-CAPA Internal
                   7645: var modalWindow = {
                   7646: 	parent:"body",
                   7647: 	windowId:null,
                   7648: 	content:null,
                   7649: 	width:null,
                   7650: 	height:null,
                   7651: 	close:function()
                   7652: 	{
                   7653: 	        $(".LCmodal-window").remove();
                   7654: 	        $(".LCmodal-overlay").remove();
                   7655: 	},
                   7656: 	open:function()
                   7657: 	{
                   7658: 		var modal = "";
                   7659: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7660: 		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;\">";
                   7661: 		modal += this.content;
                   7662: 		modal += "</div>";	
                   7663: 
                   7664: 		$(this.parent).append(modal);
                   7665: 
                   7666: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7667: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7668: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7669: 	}
                   7670: };
1.1140    raeburn  7671: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      7672: 	{
                   7673: 		modalWindow.windowId = "myModal";
                   7674: 		modalWindow.width = width;
                   7675: 		modalWindow.height = height;
1.1140    raeburn  7676: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'>&lt/iframe>";
1.1030    www      7677: 		modalWindow.open();
                   7678: 	};	
                   7679: // END LON-CAPA Internal -->
                   7680: // ]]>
                   7681: </script>
                   7682: ENDMODAL
                   7683: }
                   7684: 
                   7685: sub modal_link {
1.1140    raeburn  7686:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      7687:     unless ($width) { $width=480; }
                   7688:     unless ($height) { $height=400; }
1.1031    www      7689:     unless ($scrolling) { $scrolling='yes'; }
1.1140    raeburn  7690:     unless ($transparency) { $transparency='true'; }
                   7691: 
1.1074    raeburn  7692:     my $target_attr;
                   7693:     if (defined($target)) {
                   7694:         $target_attr = 'target="'.$target.'"';
                   7695:     }
                   7696:     return <<"ENDLINK";
1.1140    raeburn  7697: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  7698:            $linktext</a>
                   7699: ENDLINK
1.1030    www      7700: }
                   7701: 
1.1032    www      7702: sub modal_adhoc_script {
                   7703:     my ($funcname,$width,$height,$content)=@_;
                   7704:     return (<<ENDADHOC);
1.1046    raeburn  7705: <script type="text/javascript">
1.1032    www      7706: // <![CDATA[
                   7707:         var $funcname = function()
                   7708:         {
                   7709:                 modalWindow.windowId = "myModal";
                   7710:                 modalWindow.width = $width;
                   7711:                 modalWindow.height = $height;
                   7712:                 modalWindow.content = '$content';
                   7713:                 modalWindow.open();
                   7714:         };  
                   7715: // ]]>
                   7716: </script>
                   7717: ENDADHOC
                   7718: }
                   7719: 
1.1041    www      7720: sub modal_adhoc_inner {
                   7721:     my ($funcname,$width,$height,$content)=@_;
                   7722:     my $innerwidth=$width-20;
                   7723:     $content=&js_ready(
1.1140    raeburn  7724:                  &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
                   7725:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   7726:                  $content.
1.1041    www      7727:                  &end_scrollbox().
1.1140    raeburn  7728:                  &end_page()
1.1041    www      7729:              );
                   7730:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7731: }
                   7732: 
                   7733: sub modal_adhoc_window {
                   7734:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7735:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7736:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7737: }
                   7738: 
                   7739: sub modal_adhoc_launch {
                   7740:     my ($funcname,$width,$height,$content)=@_;
                   7741:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7742: <script type="text/javascript">
                   7743: // <![CDATA[
                   7744: $funcname();
                   7745: // ]]>
                   7746: </script>
                   7747: ENDLAUNCH
                   7748: }
                   7749: 
                   7750: sub modal_adhoc_close {
                   7751:     return (<<ENDCLOSE);
                   7752: <script type="text/javascript">
                   7753: // <![CDATA[
                   7754: modalWindow.close();
                   7755: // ]]>
                   7756: </script>
                   7757: ENDCLOSE
                   7758: }
                   7759: 
1.1038    www      7760: sub togglebox_script {
                   7761:    return(<<ENDTOGGLE);
                   7762: <script type="text/javascript"> 
                   7763: // <![CDATA[
                   7764: function LCtoggleDisplay(id,hidetext,showtext) {
                   7765:    link = document.getElementById(id + "link").childNodes[0];
                   7766:    with (document.getElementById(id).style) {
                   7767:       if (display == "none" ) {
                   7768:           display = "inline";
                   7769:           link.nodeValue = hidetext;
                   7770:         } else {
                   7771:           display = "none";
                   7772:           link.nodeValue = showtext;
                   7773:        }
                   7774:    }
                   7775: }
                   7776: // ]]>
                   7777: </script>
                   7778: ENDTOGGLE
                   7779: }
                   7780: 
1.1039    www      7781: sub start_togglebox {
                   7782:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7783:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7784:     unless ($showtext) { $showtext=&mt('show'); }
                   7785:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7786:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7787:     return &start_data_table().
                   7788:            &start_data_table_header_row().
                   7789:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7790:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7791:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7792:            &end_data_table_header_row().
                   7793:            '<tr id="'.$id.'" style="display:none""><td>';
                   7794: }
                   7795: 
                   7796: sub end_togglebox {
                   7797:     return '</td></tr>'.&end_data_table();
                   7798: }
                   7799: 
1.1041    www      7800: sub LCprogressbar_script {
1.1045    www      7801:    my ($id)=@_;
1.1041    www      7802:    return(<<ENDPROGRESS);
                   7803: <script type="text/javascript">
                   7804: // <![CDATA[
1.1045    www      7805: \$('#progressbar$id').progressbar({
1.1041    www      7806:   value: 0,
                   7807:   change: function(event, ui) {
                   7808:     var newVal = \$(this).progressbar('option', 'value');
                   7809:     \$('.pblabel', this).text(LCprogressTxt);
                   7810:   }
                   7811: });
                   7812: // ]]>
                   7813: </script>
                   7814: ENDPROGRESS
                   7815: }
                   7816: 
                   7817: sub LCprogressbarUpdate_script {
                   7818:    return(<<ENDPROGRESSUPDATE);
                   7819: <style type="text/css">
                   7820: .ui-progressbar { position:relative; }
                   7821: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7822: </style>
                   7823: <script type="text/javascript">
                   7824: // <![CDATA[
1.1045    www      7825: var LCprogressTxt='---';
                   7826: 
                   7827: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7828:    LCprogressTxt=progresstext;
1.1045    www      7829:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7830: }
                   7831: // ]]>
                   7832: </script>
                   7833: ENDPROGRESSUPDATE
                   7834: }
                   7835: 
1.1042    www      7836: my $LClastpercent;
1.1045    www      7837: my $LCidcnt;
                   7838: my $LCcurrentid;
1.1042    www      7839: 
1.1041    www      7840: sub LCprogressbar {
1.1042    www      7841:     my ($r)=(@_);
                   7842:     $LClastpercent=0;
1.1045    www      7843:     $LCidcnt++;
                   7844:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7845:     my $starting=&mt('Starting');
                   7846:     my $content=(<<ENDPROGBAR);
1.1045    www      7847:   <div id="progressbar$LCcurrentid">
1.1041    www      7848:     <span class="pblabel">$starting</span>
                   7849:   </div>
                   7850: ENDPROGBAR
1.1045    www      7851:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7852: }
                   7853: 
                   7854: sub LCprogressbarUpdate {
1.1042    www      7855:     my ($r,$val,$text)=@_;
                   7856:     unless ($val) { 
                   7857:        if ($LClastpercent) {
                   7858:            $val=$LClastpercent;
                   7859:        } else {
                   7860:            $val=0;
                   7861:        }
                   7862:     }
1.1041    www      7863:     if ($val<0) { $val=0; }
                   7864:     if ($val>100) { $val=0; }
1.1042    www      7865:     $LClastpercent=$val;
1.1041    www      7866:     unless ($text) { $text=$val.'%'; }
                   7867:     $text=&js_ready($text);
1.1044    www      7868:     &r_print($r,<<ENDUPDATE);
1.1041    www      7869: <script type="text/javascript">
                   7870: // <![CDATA[
1.1045    www      7871: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7872: // ]]>
                   7873: </script>
                   7874: ENDUPDATE
1.1035    www      7875: }
                   7876: 
1.1042    www      7877: sub LCprogressbarClose {
                   7878:     my ($r)=@_;
                   7879:     $LClastpercent=0;
1.1044    www      7880:     &r_print($r,<<ENDCLOSE);
1.1042    www      7881: <script type="text/javascript">
                   7882: // <![CDATA[
1.1045    www      7883: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7884: // ]]>
                   7885: </script>
                   7886: ENDCLOSE
1.1044    www      7887: }
                   7888: 
                   7889: sub r_print {
                   7890:     my ($r,$to_print)=@_;
                   7891:     if ($r) {
                   7892:       $r->print($to_print);
                   7893:       $r->rflush();
                   7894:     } else {
                   7895:       print($to_print);
                   7896:     }
1.1042    www      7897: }
                   7898: 
1.320     albertel 7899: sub html_encode {
                   7900:     my ($result) = @_;
                   7901: 
1.322     albertel 7902:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7903:     
                   7904:     return $result;
                   7905: }
1.1044    www      7906: 
1.317     albertel 7907: sub js_ready {
                   7908:     my ($result) = @_;
                   7909: 
1.323     albertel 7910:     $result =~ s/[\n\r]/ /xmsg;
                   7911:     $result =~ s/\\/\\\\/xmsg;
                   7912:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7913:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7914:     
                   7915:     return $result;
                   7916: }
                   7917: 
1.315     albertel 7918: sub validate_page {
                   7919:     if (  exists($env{'internal.start_page'})
1.316     albertel 7920: 	  &&     $env{'internal.start_page'} > 1) {
                   7921: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7922: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7923: 				 $ENV{'request.filename'});
1.315     albertel 7924:     }
                   7925:     if (  exists($env{'internal.end_page'})
1.316     albertel 7926: 	  &&     $env{'internal.end_page'} > 1) {
                   7927: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7928: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7929: 				 $env{'request.filename'});
1.315     albertel 7930:     }
                   7931:     if (     exists($env{'internal.start_page'})
                   7932: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7933: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7934: 				 $env{'request.filename'});
1.315     albertel 7935:     }
                   7936:     if (   ! exists($env{'internal.start_page'})
                   7937: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7938: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7939: 				 $env{'request.filename'});
1.315     albertel 7940:     }
1.306     albertel 7941: }
1.315     albertel 7942: 
1.996     www      7943: 
                   7944: sub start_scrollbox {
1.1140    raeburn  7945:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  7946:     unless ($outerwidth) { $outerwidth='520px'; }
                   7947:     unless ($width) { $width='500px'; }
                   7948:     unless ($height) { $height='200px'; }
1.1075    raeburn  7949:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7950:     if ($id ne '') {
1.1140    raeburn  7951:         $table_id = ' id="table_'.$id.'"';
1.1137    raeburn  7952:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  7953:     }
1.1075    raeburn  7954:     if ($bgcolor ne '') {
                   7955:         $tdcol = "background-color: $bgcolor;";
                   7956:     }
1.1137    raeburn  7957:     my $nicescroll_js;
                   7958:     if ($env{'browser.mobile'}) {
1.1140    raeburn  7959:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   7960:     }
                   7961:     return <<"END";
                   7962: $nicescroll_js
                   7963: 
                   7964: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
                   7965: <div style="overflow:auto; width:$width; height:$height;"$div_id>
                   7966: END
                   7967: }
                   7968: 
                   7969: sub end_scrollbox {
                   7970:     return '</div></td></tr></table>';
                   7971: }
                   7972: 
                   7973: sub nicescroll_javascript {
                   7974:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   7975:     my %options;
                   7976:     if (ref($cursor) eq 'HASH') {
                   7977:         %options = %{$cursor};
                   7978:     }
                   7979:     unless ($options{'railalign'} =~ /^left|right$/) {
                   7980:         $options{'railalign'} = 'left';
                   7981:     }
                   7982:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   7983:         my $function  = &get_users_function();
                   7984:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138    raeburn  7985:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140    raeburn  7986:             $options{'cursorcolor'} = '#00F';
1.1138    raeburn  7987:         }
1.1140    raeburn  7988:     }
                   7989:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   7990:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138    raeburn  7991:             $options{'cursoropacity'}='1.0';
                   7992:         }
1.1140    raeburn  7993:     } else {
                   7994:         $options{'cursoropacity'}='1.0';
                   7995:     }
                   7996:     if ($options{'cursorfixedheight'} eq 'none') {
                   7997:         delete($options{'cursorfixedheight'});
                   7998:     } else {
                   7999:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8000:     }
                   8001:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8002:         delete($options{'railoffset'});
                   8003:     }
                   8004:     my @niceoptions;
                   8005:     while (my($key,$value) = each(%options)) {
                   8006:         if ($value =~ /^\{.+\}$/) {
                   8007:             push(@niceoptions,$key.':'.$value);
1.1138    raeburn  8008:         } else {
1.1140    raeburn  8009:             push(@niceoptions,$key.':"'.$value.'"');
1.1138    raeburn  8010:         }
1.1140    raeburn  8011:     }
                   8012:     my $nicescroll_js = '
1.1137    raeburn  8013: $(document).ready(
1.1140    raeburn  8014:       function() {
                   8015:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8016:       }
1.1137    raeburn  8017: );
                   8018: ';
1.1140    raeburn  8019:     if ($framecheck) {
                   8020:         $nicescroll_js .= '
                   8021: function expand_div(caller) {
                   8022:     if (top === self) {
                   8023:         document.getElementById("'.$id.'").style.width = "auto";
                   8024:         document.getElementById("'.$id.'").style.height = "auto";
                   8025:     } else {
                   8026:         try {
                   8027:             if (parent.frames) {
                   8028:                 if (parent.frames.length > 1) {
                   8029:                     var framesrc = parent.frames[1].location.href;
                   8030:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8031:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8032:                         document.getElementById("'.$id.'").style.width = "auto";
                   8033:                         document.getElementById("'.$id.'").style.height = "auto";
                   8034:                     }
                   8035:                 }
                   8036:             }
                   8037:         } catch (e) {
                   8038:             return;
                   8039:         }
1.1137    raeburn  8040:     }
1.1140    raeburn  8041:     return;
1.996     www      8042: }
1.1140    raeburn  8043: ';
                   8044:     }
                   8045:     if ($needjsready) {
                   8046:         $nicescroll_js = '
                   8047: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8048:     } else {
                   8049:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8050:     }
                   8051:     return $nicescroll_js;
1.996     www      8052: }
                   8053: 
1.318     albertel 8054: sub simple_error_page {
1.1150    bisitz   8055:     my ($r,$title,$msg,$args) = @_;
1.1151    raeburn  8056:     if (ref($args) eq 'HASH') {
                   8057:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8058:     } else {
                   8059:         $msg = &mt($msg);
                   8060:     }
1.1150    bisitz   8061: 
1.318     albertel 8062:     my $page =
                   8063: 	&Apache::loncommon::start_page($title).
1.1150    bisitz   8064: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8065: 	&Apache::loncommon::end_page();
                   8066:     if (ref($r)) {
                   8067: 	$r->print($page);
1.327     albertel 8068: 	return;
1.318     albertel 8069:     }
                   8070:     return $page;
                   8071: }
1.347     albertel 8072: 
                   8073: {
1.610     albertel 8074:     my @row_count;
1.961     onken    8075: 
                   8076:     sub start_data_table_count {
                   8077:         unshift(@row_count, 0);
                   8078:         return;
                   8079:     }
                   8080: 
                   8081:     sub end_data_table_count {
                   8082:         shift(@row_count);
                   8083:         return;
                   8084:     }
                   8085: 
1.347     albertel 8086:     sub start_data_table {
1.1018    raeburn  8087: 	my ($add_class,$id) = @_;
1.422     albertel 8088: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8089:         my $table_id;
                   8090:         if (defined($id)) {
                   8091:             $table_id = ' id="'.$id.'"';
                   8092:         }
1.961     onken    8093: 	&start_data_table_count();
1.1018    raeburn  8094: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8095:     }
                   8096: 
                   8097:     sub end_data_table {
1.961     onken    8098: 	&end_data_table_count();
1.389     albertel 8099: 	return '</table>'."\n";;
1.347     albertel 8100:     }
                   8101: 
                   8102:     sub start_data_table_row {
1.974     wenzelju 8103: 	my ($add_class, $id) = @_;
1.610     albertel 8104: 	$row_count[0]++;
                   8105: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8106: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8107:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8108:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8109:     }
1.471     banghart 8110:     
                   8111:     sub continue_data_table_row {
1.974     wenzelju 8112: 	my ($add_class, $id) = @_;
1.610     albertel 8113: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8114: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8115:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8116:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8117:     }
1.347     albertel 8118: 
                   8119:     sub end_data_table_row {
1.389     albertel 8120: 	return '</tr>'."\n";;
1.347     albertel 8121:     }
1.367     www      8122: 
1.421     albertel 8123:     sub start_data_table_empty_row {
1.707     bisitz   8124: #	$row_count[0]++;
1.421     albertel 8125: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8126:     }
                   8127: 
                   8128:     sub end_data_table_empty_row {
                   8129: 	return '</tr>'."\n";;
                   8130:     }
                   8131: 
1.367     www      8132:     sub start_data_table_header_row {
1.389     albertel 8133: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8134:     }
                   8135: 
                   8136:     sub end_data_table_header_row {
1.389     albertel 8137: 	return '</tr>'."\n";;
1.367     www      8138:     }
1.890     droeschl 8139: 
                   8140:     sub data_table_caption {
                   8141:         my $caption = shift;
                   8142:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8143:     }
1.347     albertel 8144: }
                   8145: 
1.548     albertel 8146: =pod
                   8147: 
                   8148: =item * &inhibit_menu_check($arg)
                   8149: 
                   8150: Checks for a inhibitmenu state and generates output to preserve it
                   8151: 
                   8152: Inputs:         $arg - can be any of
                   8153:                      - undef - in which case the return value is a string 
                   8154:                                to add  into arguments list of a uri
                   8155:                      - 'input' - in which case the return value is a HTML
                   8156:                                  <form> <input> field of type hidden to
                   8157:                                  preserve the value
                   8158:                      - a url - in which case the return value is the url with
                   8159:                                the neccesary cgi args added to preserve the
                   8160:                                inhibitmenu state
                   8161:                      - a ref to a url - no return value, but the string is
                   8162:                                         updated to include the neccessary cgi
                   8163:                                         args to preserve the inhibitmenu state
                   8164: 
                   8165: =cut
                   8166: 
                   8167: sub inhibit_menu_check {
                   8168:     my ($arg) = @_;
                   8169:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8170:     if ($arg eq 'input') {
                   8171: 	if ($env{'form.inhibitmenu'}) {
                   8172: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8173: 	} else {
                   8174: 	    return
                   8175: 	}
                   8176:     }
                   8177:     if ($env{'form.inhibitmenu'}) {
                   8178: 	if (ref($arg)) {
                   8179: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8180: 	} elsif ($arg eq '') {
                   8181: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8182: 	} else {
                   8183: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8184: 	}
                   8185:     }
                   8186:     if (!ref($arg)) {
                   8187: 	return $arg;
                   8188:     }
                   8189: }
                   8190: 
1.251     albertel 8191: ###############################################
1.182     matthew  8192: 
                   8193: =pod
                   8194: 
1.549     albertel 8195: =back
                   8196: 
                   8197: =head1 User Information Routines
                   8198: 
                   8199: =over 4
                   8200: 
1.405     albertel 8201: =item * &get_users_function()
1.182     matthew  8202: 
                   8203: Used by &bodytag to determine the current users primary role.
                   8204: Returns either 'student','coordinator','admin', or 'author'.
                   8205: 
                   8206: =cut
                   8207: 
                   8208: ###############################################
                   8209: sub get_users_function {
1.815     tempelho 8210:     my $function = 'norole';
1.818     tempelho 8211:     if ($env{'request.role'}=~/^(st)/) {
                   8212:         $function='student';
                   8213:     }
1.907     raeburn  8214:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8215:         $function='coordinator';
                   8216:     }
1.258     albertel 8217:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8218:         $function='admin';
                   8219:     }
1.826     bisitz   8220:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8221:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8222:         $function='author';
                   8223:     }
                   8224:     return $function;
1.54      www      8225: }
1.99      www      8226: 
                   8227: ###############################################
                   8228: 
1.233     raeburn  8229: =pod
                   8230: 
1.821     raeburn  8231: =item * &show_course()
                   8232: 
                   8233: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8234: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8235: 
                   8236: Inputs:
                   8237: None
                   8238: 
                   8239: Outputs:
                   8240: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8241: 
                   8242: =cut
                   8243: 
                   8244: ###############################################
                   8245: sub show_course {
                   8246:     my $course = !$env{'user.adv'};
                   8247:     if (!$env{'user.adv'}) {
                   8248:         foreach my $env (keys(%env)) {
                   8249:             next if ($env !~ m/^user\.priv\./);
                   8250:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8251:                 $course = 0;
                   8252:                 last;
                   8253:             }
                   8254:         }
                   8255:     }
                   8256:     return $course;
                   8257: }
                   8258: 
                   8259: ###############################################
                   8260: 
                   8261: =pod
                   8262: 
1.542     raeburn  8263: =item * &check_user_status()
1.274     raeburn  8264: 
                   8265: Determines current status of supplied role for a
                   8266: specific user. Roles can be active, previous or future.
                   8267: 
                   8268: Inputs: 
                   8269: user's domain, user's username, course's domain,
1.375     raeburn  8270: course's number, optional section ID.
1.274     raeburn  8271: 
                   8272: Outputs:
                   8273: role status: active, previous or future. 
                   8274: 
                   8275: =cut
                   8276: 
                   8277: sub check_user_status {
1.412     raeburn  8278:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8279:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8280:     my @uroles = keys %userinfo;
                   8281:     my $srchstr;
                   8282:     my $active_chk = 'none';
1.412     raeburn  8283:     my $now = time;
1.274     raeburn  8284:     if (@uroles > 0) {
1.908     raeburn  8285:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8286:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8287:         } else {
1.412     raeburn  8288:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8289:         }
                   8290:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8291:             my $role_end = 0;
                   8292:             my $role_start = 0;
                   8293:             $active_chk = 'active';
1.412     raeburn  8294:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8295:                 $role_end = $1;
                   8296:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8297:                     $role_start = $1;
1.274     raeburn  8298:                 }
                   8299:             }
                   8300:             if ($role_start > 0) {
1.412     raeburn  8301:                 if ($now < $role_start) {
1.274     raeburn  8302:                     $active_chk = 'future';
                   8303:                 }
                   8304:             }
                   8305:             if ($role_end > 0) {
1.412     raeburn  8306:                 if ($now > $role_end) {
1.274     raeburn  8307:                     $active_chk = 'previous';
                   8308:                 }
                   8309:             }
                   8310:         }
                   8311:     }
                   8312:     return $active_chk;
                   8313: }
                   8314: 
                   8315: ###############################################
                   8316: 
                   8317: =pod
                   8318: 
1.405     albertel 8319: =item * &get_sections()
1.233     raeburn  8320: 
                   8321: Determines all the sections for a course including
                   8322: sections with students and sections containing other roles.
1.419     raeburn  8323: Incoming parameters: 
                   8324: 
                   8325: 1. domain
                   8326: 2. course number 
                   8327: 3. reference to array containing roles for which sections should 
                   8328: be gathered (optional).
                   8329: 4. reference to array containing status types for which sections 
                   8330: should be gathered (optional).
                   8331: 
                   8332: If the third argument is undefined, sections are gathered for any role. 
                   8333: If the fourth argument is undefined, sections are gathered for any status.
                   8334: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8335:  
1.374     raeburn  8336: Returns section hash (keys are section IDs, values are
                   8337: number of users in each section), subject to the
1.419     raeburn  8338: optional roles filter, optional status filter 
1.233     raeburn  8339: 
                   8340: =cut
                   8341: 
                   8342: ###############################################
                   8343: sub get_sections {
1.419     raeburn  8344:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8345:     if (!defined($cdom) || !defined($cnum)) {
                   8346:         my $cid =  $env{'request.course.id'};
                   8347: 
                   8348: 	return if (!defined($cid));
                   8349: 
                   8350:         $cdom = $env{'course.'.$cid.'.domain'};
                   8351:         $cnum = $env{'course.'.$cid.'.num'};
                   8352:     }
                   8353: 
                   8354:     my %sectioncount;
1.419     raeburn  8355:     my $now = time;
1.240     albertel 8356: 
1.1118    raeburn  8357:     my $check_students = 1;
                   8358:     my $only_students = 0;
                   8359:     if (ref($possible_roles) eq 'ARRAY') {
                   8360:         if (grep(/^st$/,@{$possible_roles})) {
                   8361:             if (@{$possible_roles} == 1) {
                   8362:                 $only_students = 1;
                   8363:             }
                   8364:         } else {
                   8365:             $check_students = 0;
                   8366:         }
                   8367:     }
                   8368: 
                   8369:     if ($check_students) { 
1.276     albertel 8370: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8371: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8372: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8373:         my $start_index = &Apache::loncoursedata::CL_START();
                   8374:         my $end_index = &Apache::loncoursedata::CL_END();
                   8375:         my $status;
1.366     albertel 8376: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8377: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8378: 				                     $data->[$status_index],
                   8379:                                                      $data->[$start_index],
                   8380:                                                      $data->[$end_index]);
                   8381:             if ($stu_status eq 'Active') {
                   8382:                 $status = 'active';
                   8383:             } elsif ($end < $now) {
                   8384:                 $status = 'previous';
                   8385:             } elsif ($start > $now) {
                   8386:                 $status = 'future';
                   8387:             } 
                   8388: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8389:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8390:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8391: 		    $sectioncount{$section}++;
                   8392:                 }
1.240     albertel 8393: 	    }
                   8394: 	}
                   8395:     }
1.1118    raeburn  8396:     if ($only_students) {
                   8397:         return %sectioncount;
                   8398:     }
1.240     albertel 8399:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8400:     foreach my $user (sort(keys(%courseroles))) {
                   8401: 	if ($user !~ /^(\w{2})/) { next; }
                   8402: 	my ($role) = ($user =~ /^(\w{2})/);
                   8403: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8404: 	my ($section,$status);
1.240     albertel 8405: 	if ($role eq 'cr' &&
                   8406: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8407: 	    $section=$1;
                   8408: 	}
                   8409: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8410: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8411:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8412:         if ($end == -1 && $start == -1) {
                   8413:             next; #deleted role
                   8414:         }
                   8415:         if (!defined($possible_status)) { 
                   8416:             $sectioncount{$section}++;
                   8417:         } else {
                   8418:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8419:                 $status = 'active';
                   8420:             } elsif ($end < $now) {
                   8421:                 $status = 'future';
                   8422:             } elsif ($start > $now) {
                   8423:                 $status = 'previous';
                   8424:             }
                   8425:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8426:                 $sectioncount{$section}++;
                   8427:             }
                   8428:         }
1.233     raeburn  8429:     }
1.366     albertel 8430:     return %sectioncount;
1.233     raeburn  8431: }
                   8432: 
1.274     raeburn  8433: ###############################################
1.294     raeburn  8434: 
                   8435: =pod
1.405     albertel 8436: 
                   8437: =item * &get_course_users()
                   8438: 
1.275     raeburn  8439: Retrieves usernames:domains for users in the specified course
                   8440: with specific role(s), and access status. 
                   8441: 
                   8442: Incoming parameters:
1.277     albertel 8443: 1. course domain
                   8444: 2. course number
                   8445: 3. access status: users must have - either active, 
1.275     raeburn  8446: previous, future, or all.
1.277     albertel 8447: 4. reference to array of permissible roles
1.288     raeburn  8448: 5. reference to array of section restrictions (optional)
                   8449: 6. reference to results object (hash of hashes).
                   8450: 7. reference to optional userdata hash
1.609     raeburn  8451: 8. reference to optional statushash
1.630     raeburn  8452: 9. flag if privileged users (except those set to unhide in
                   8453:    course settings) should be excluded    
1.609     raeburn  8454: Keys of top level results hash are roles.
1.275     raeburn  8455: Keys of inner hashes are username:domain, with 
                   8456: values set to access type.
1.288     raeburn  8457: Optional userdata hash returns an array with arguments in the 
                   8458: same order as loncoursedata::get_classlist() for student data.
                   8459: 
1.609     raeburn  8460: Optional statushash returns
                   8461: 
1.288     raeburn  8462: Entries for end, start, section and status are blank because
                   8463: of the possibility of multiple values for non-student roles.
                   8464: 
1.275     raeburn  8465: =cut
1.405     albertel 8466: 
1.275     raeburn  8467: ###############################################
1.405     albertel 8468: 
1.275     raeburn  8469: sub get_course_users {
1.630     raeburn  8470:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8471:     my %idx = ();
1.419     raeburn  8472:     my %seclists;
1.288     raeburn  8473: 
                   8474:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8475:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8476:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8477:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8478:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8479:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8480:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8481:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8482: 
1.290     albertel 8483:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8484:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8485:         my $now = time;
1.277     albertel 8486:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8487:             my $match = 0;
1.412     raeburn  8488:             my $secmatch = 0;
1.419     raeburn  8489:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8490:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8491:             if ($section eq '') {
                   8492:                 $section = 'none';
                   8493:             }
1.291     albertel 8494:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8495:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8496:                     $secmatch = 1;
                   8497:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8498:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8499:                         $secmatch = 1;
                   8500:                     }
                   8501:                 } else {  
1.419     raeburn  8502: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8503: 		        $secmatch = 1;
                   8504:                     }
1.290     albertel 8505: 		}
1.412     raeburn  8506:                 if (!$secmatch) {
                   8507:                     next;
                   8508:                 }
1.419     raeburn  8509:             }
1.275     raeburn  8510:             if (defined($$types{'active'})) {
1.288     raeburn  8511:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8512:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8513:                     $match = 1;
1.275     raeburn  8514:                 }
                   8515:             }
                   8516:             if (defined($$types{'previous'})) {
1.609     raeburn  8517:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8518:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8519:                     $match = 1;
1.275     raeburn  8520:                 }
                   8521:             }
                   8522:             if (defined($$types{'future'})) {
1.609     raeburn  8523:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8524:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8525:                     $match = 1;
1.275     raeburn  8526:                 }
                   8527:             }
1.609     raeburn  8528:             if ($match) {
                   8529:                 push(@{$seclists{$student}},$section);
                   8530:                 if (ref($userdata) eq 'HASH') {
                   8531:                     $$userdata{$student} = $$classlist{$student};
                   8532:                 }
                   8533:                 if (ref($statushash) eq 'HASH') {
                   8534:                     $statushash->{$student}{'st'}{$section} = $status;
                   8535:                 }
1.288     raeburn  8536:             }
1.275     raeburn  8537:         }
                   8538:     }
1.412     raeburn  8539:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8540:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8541:         my $now = time;
1.609     raeburn  8542:         my %displaystatus = ( previous => 'Expired',
                   8543:                               active   => 'Active',
                   8544:                               future   => 'Future',
                   8545:                             );
1.1121    raeburn  8546:         my (%nothide,@possdoms);
1.630     raeburn  8547:         if ($hidepriv) {
                   8548:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8549:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8550:                 if ($user !~ /:/) {
                   8551:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8552:                 } else {
                   8553:                     $nothide{$user} = 1;
                   8554:                 }
                   8555:             }
1.1121    raeburn  8556:             my @possdoms = ($cdom);
                   8557:             if ($coursehash{'checkforpriv'}) {
                   8558:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   8559:             }
1.630     raeburn  8560:         }
1.439     raeburn  8561:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8562:             my $match = 0;
1.412     raeburn  8563:             my $secmatch = 0;
1.439     raeburn  8564:             my $status;
1.412     raeburn  8565:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8566:             $user =~ s/:$//;
1.439     raeburn  8567:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8568:             if ($end == -1 || $start == -1) {
                   8569:                 next;
                   8570:             }
                   8571:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8572:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8573:                 my ($uname,$udom) = split(/:/,$user);
                   8574:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8575:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8576:                         $secmatch = 1;
                   8577:                     } elsif ($usec eq '') {
1.420     albertel 8578:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8579:                             $secmatch = 1;
                   8580:                         }
                   8581:                     } else {
                   8582:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8583:                             $secmatch = 1;
                   8584:                         }
                   8585:                     }
                   8586:                     if (!$secmatch) {
                   8587:                         next;
                   8588:                     }
1.288     raeburn  8589:                 }
1.419     raeburn  8590:                 if ($usec eq '') {
                   8591:                     $usec = 'none';
                   8592:                 }
1.275     raeburn  8593:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8594:                     if ($hidepriv) {
1.1121    raeburn  8595:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  8596:                             (!$nothide{$uname.':'.$udom})) {
                   8597:                             next;
                   8598:                         }
                   8599:                     }
1.503     raeburn  8600:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8601:                         $status = 'previous';
                   8602:                     } elsif ($start > $now) {
                   8603:                         $status = 'future';
                   8604:                     } else {
                   8605:                         $status = 'active';
                   8606:                     }
1.277     albertel 8607:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8608:                         if ($status eq $type) {
1.420     albertel 8609:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8610:                                 push(@{$$users{$role}{$user}},$type);
                   8611:                             }
1.288     raeburn  8612:                             $match = 1;
                   8613:                         }
                   8614:                     }
1.419     raeburn  8615:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8616:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8617: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8618:                         }
1.420     albertel 8619:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8620:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8621:                         }
1.609     raeburn  8622:                         if (ref($statushash) eq 'HASH') {
                   8623:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8624:                         }
1.275     raeburn  8625:                     }
                   8626:                 }
                   8627:             }
                   8628:         }
1.290     albertel 8629:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8630:             if ((defined($cdom)) && (defined($cnum))) {
                   8631:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8632:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8633:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8634:                     next if ($owner eq '');
                   8635:                     my ($ownername,$ownerdom);
                   8636:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8637:                         $ownername = $1;
                   8638:                         $ownerdom = $2;
                   8639:                     } else {
                   8640:                         $ownername = $owner;
                   8641:                         $ownerdom = $cdom;
                   8642:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8643:                     }
                   8644:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8645:                     if (defined($userdata) && 
1.609     raeburn  8646: 			!exists($$userdata{$owner})) {
                   8647: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8648:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8649:                             push(@{$seclists{$owner}},'none');
                   8650:                         }
                   8651:                         if (ref($statushash) eq 'HASH') {
                   8652:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8653:                         }
1.290     albertel 8654: 		    }
1.279     raeburn  8655:                 }
                   8656:             }
                   8657:         }
1.419     raeburn  8658:         foreach my $user (keys(%seclists)) {
                   8659:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8660:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8661:         }
1.275     raeburn  8662:     }
                   8663:     return;
                   8664: }
                   8665: 
1.288     raeburn  8666: sub get_user_info {
                   8667:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8668:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8669: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8670:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8671:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8672:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8673:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8674:     return;
                   8675: }
1.275     raeburn  8676: 
1.472     raeburn  8677: ###############################################
                   8678: 
                   8679: =pod
                   8680: 
                   8681: =item * &get_user_quota()
                   8682: 
1.1134    raeburn  8683: Retrieves quota assigned for storage of user files.
                   8684: Default is to report quota for portfolio files.
1.472     raeburn  8685: 
                   8686: Incoming parameters:
                   8687: 1. user's username
                   8688: 2. user's domain
1.1134    raeburn  8689: 3. quota name - portfolio, author, or course
1.1136    raeburn  8690:    (if no quota name provided, defaults to portfolio).
                   8691: 4. crstype - official, unofficial or community, if quota name is
                   8692:    course
1.472     raeburn  8693: 
                   8694: Returns:
1.536     raeburn  8695: 1. Disk quota (in Mb) assigned to student.
                   8696: 2. (Optional) Type of setting: custom or default
                   8697:    (individually assigned or default for user's 
                   8698:    institutional status).
                   8699: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8700:    or student - types as defined in localenroll::inst_usertypes 
                   8701:    for user's domain, which determines default quota for user.
                   8702: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8703: 
                   8704: If a value has been stored in the user's environment, 
1.536     raeburn  8705: it will return that, otherwise it returns the maximal default
1.1134    raeburn  8706: defined for the user's institutional status(es) in the domain.
1.472     raeburn  8707: 
                   8708: =cut
                   8709: 
                   8710: ###############################################
                   8711: 
                   8712: 
                   8713: sub get_user_quota {
1.1136    raeburn  8714:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  8715:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8716:     if (!defined($udom)) {
                   8717:         $udom = $env{'user.domain'};
                   8718:     }
                   8719:     if (!defined($uname)) {
                   8720:         $uname = $env{'user.name'};
                   8721:     }
                   8722:     if (($udom eq '' || $uname eq '') ||
                   8723:         ($udom eq 'public') && ($uname eq 'public')) {
                   8724:         $quota = 0;
1.536     raeburn  8725:         $quotatype = 'default';
                   8726:         $defquota = 0; 
1.472     raeburn  8727:     } else {
1.536     raeburn  8728:         my $inststatus;
1.1134    raeburn  8729:         if ($quotaname eq 'course') {
                   8730:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   8731:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   8732:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   8733:             } else {
                   8734:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   8735:                 $quota = $cenv{'internal.uploadquota'};
                   8736:             }
1.536     raeburn  8737:         } else {
1.1134    raeburn  8738:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8739:                 if ($quotaname eq 'author') {
                   8740:                     $quota = $env{'environment.authorquota'};
                   8741:                 } else {
                   8742:                     $quota = $env{'environment.portfolioquota'};
                   8743:                 }
                   8744:                 $inststatus = $env{'environment.inststatus'};
                   8745:             } else {
                   8746:                 my %userenv = 
                   8747:                     &Apache::lonnet::get('environment',['portfolioquota',
                   8748:                                          'authorquota','inststatus'],$udom,$uname);
                   8749:                 my ($tmp) = keys(%userenv);
                   8750:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8751:                     if ($quotaname eq 'author') {
                   8752:                         $quota = $userenv{'authorquota'};
                   8753:                     } else {
                   8754:                         $quota = $userenv{'portfolioquota'};
                   8755:                     }
                   8756:                     $inststatus = $userenv{'inststatus'};
                   8757:                 } else {
                   8758:                     undef(%userenv);
                   8759:                 }
                   8760:             }
                   8761:         }
                   8762:         if ($quota eq '' || wantarray) {
                   8763:             if ($quotaname eq 'course') {
                   8764:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1136    raeburn  8765:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') || ($crstype eq 'community')) { 
                   8766:                     $defquota = $domdefs{$crstype.'quota'};
                   8767:                 }
                   8768:                 if ($defquota eq '') {
                   8769:                     $defquota = 500;
                   8770:                 }
1.1134    raeburn  8771:             } else {
                   8772:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   8773:             }
                   8774:             if ($quota eq '') {
                   8775:                 $quota = $defquota;
                   8776:                 $quotatype = 'default';
                   8777:             } else {
                   8778:                 $quotatype = 'custom';
                   8779:             }
1.472     raeburn  8780:         }
                   8781:     }
1.536     raeburn  8782:     if (wantarray) {
                   8783:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8784:     } else {
                   8785:         return $quota;
                   8786:     }
1.472     raeburn  8787: }
                   8788: 
                   8789: ###############################################
                   8790: 
                   8791: =pod
                   8792: 
                   8793: =item * &default_quota()
                   8794: 
1.536     raeburn  8795: Retrieves default quota assigned for storage of user portfolio files,
                   8796: given an (optional) user's institutional status.
1.472     raeburn  8797: 
                   8798: Incoming parameters:
1.1142    raeburn  8799: 
1.472     raeburn  8800: 1. domain
1.536     raeburn  8801: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8802:    status types (e.g., faculty, staff, student etc.)
                   8803:    which apply to the user for whom the default is being retrieved.
                   8804:    If the institutional status string in undefined, the domain
1.1134    raeburn  8805:    default quota will be returned.
                   8806: 3.  quota name - portfolio, author, or course
                   8807:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  8808: 
                   8809: Returns:
1.1142    raeburn  8810: 
1.472     raeburn  8811: 1. Default disk quota (in Mb) for user portfolios in the domain.
1.536     raeburn  8812: 2. (Optional) institutional type which determined the value of the
                   8813:    default quota.
1.472     raeburn  8814: 
                   8815: If a value has been stored in the domain's configuration db,
                   8816: it will return that, otherwise it returns 20 (for backwards 
                   8817: compatibility with domains which have not set up a configuration
                   8818: db file; the original statically defined portfolio quota was 20 Mb). 
                   8819: 
1.536     raeburn  8820: If the user's status includes multiple types (e.g., staff and student),
                   8821: the largest default quota which applies to the user determines the
                   8822: default quota returned.
                   8823: 
1.472     raeburn  8824: =cut
                   8825: 
                   8826: ###############################################
                   8827: 
                   8828: 
                   8829: sub default_quota {
1.1134    raeburn  8830:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  8831:     my ($defquota,$settingstatus);
                   8832:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8833:                                             ['quotas'],$udom);
1.1134    raeburn  8834:     my $key = 'defaultquota';
                   8835:     if ($quotaname eq 'author') {
                   8836:         $key = 'authorquota';
                   8837:     }
1.622     raeburn  8838:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8839:         if ($inststatus ne '') {
1.765     raeburn  8840:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8841:             foreach my $item (@statuses) {
1.1134    raeburn  8842:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8843:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  8844:                         if ($defquota eq '') {
1.1134    raeburn  8845:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8846:                             $settingstatus = $item;
1.1134    raeburn  8847:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   8848:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8849:                             $settingstatus = $item;
                   8850:                         }
                   8851:                     }
1.1134    raeburn  8852:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  8853:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8854:                         if ($defquota eq '') {
                   8855:                             $defquota = $quotahash{'quotas'}{$item};
                   8856:                             $settingstatus = $item;
                   8857:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8858:                             $defquota = $quotahash{'quotas'}{$item};
                   8859:                             $settingstatus = $item;
                   8860:                         }
1.536     raeburn  8861:                     }
                   8862:                 }
                   8863:             }
                   8864:         }
                   8865:         if ($defquota eq '') {
1.1134    raeburn  8866:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8867:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   8868:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  8869:                 $defquota = $quotahash{'quotas'}{'default'};
                   8870:             }
1.536     raeburn  8871:             $settingstatus = 'default';
1.1139    raeburn  8872:             if ($defquota eq '') {
                   8873:                 if ($quotaname eq 'author') {
                   8874:                     $defquota = 500;
                   8875:                 }
                   8876:             }
1.536     raeburn  8877:         }
                   8878:     } else {
                   8879:         $settingstatus = 'default';
1.1134    raeburn  8880:         if ($quotaname eq 'author') {
                   8881:             $defquota = 500;
                   8882:         } else {
                   8883:             $defquota = 20;
                   8884:         }
1.536     raeburn  8885:     }
                   8886:     if (wantarray) {
                   8887:         return ($defquota,$settingstatus);
1.472     raeburn  8888:     } else {
1.536     raeburn  8889:         return $defquota;
1.472     raeburn  8890:     }
                   8891: }
                   8892: 
1.1135    raeburn  8893: ###############################################
                   8894: 
                   8895: =pod
                   8896: 
1.1136    raeburn  8897: =item * &excess_filesize_warning()
1.1135    raeburn  8898: 
                   8899: Returns warning message if upload of file to authoring space, or copying
1.1136    raeburn  8900: of existing file within authoring space will cause quota for the authoring
1.1146    raeburn  8901: space to be exceeded.
1.1136    raeburn  8902: 
                   8903: Same, if upload of a file directly to a course/community via Course Editor
1.1137    raeburn  8904: will cause quota for uploaded content for the course to be exceeded.
1.1135    raeburn  8905: 
                   8906: Inputs: 6
1.1136    raeburn  8907: 1. username or coursenum
1.1135    raeburn  8908: 2. domain
1.1136    raeburn  8909: 3. context ('author' or 'course')
1.1135    raeburn  8910: 4. filename of file for which action is being requested
                   8911: 5. filesize (kB) of file
                   8912: 6. action being taken: copy or upload.
                   8913: 
                   8914: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142    raeburn  8915:          otherwise return null.
                   8916: 
                   8917: =back
1.1135    raeburn  8918: 
                   8919: =cut
                   8920: 
1.1136    raeburn  8921: sub excess_filesize_warning {
                   8922:     my ($uname,$udom,$context,$filename,$filesize,$action) = @_;
                   8923:     my $current_disk_usage = 0;
                   8924:     my $disk_quota = &get_user_quota($uname,$udom,$context); #expressed in MB
                   8925:     if ($context eq 'author') {
                   8926:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   8927:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   8928:     } else {
                   8929:         foreach my $subdir ('docs','supplemental') {
                   8930:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   8931:         }
                   8932:     }
1.1135    raeburn  8933:     $disk_quota = int($disk_quota * 1000);
                   8934:     if (($current_disk_usage + $filesize) > $disk_quota) {
                   8935:         return '<p><span class="LC_warning">'.
                   8936:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
                   8937:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</span>'.
                   8938:                '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   8939:                             $disk_quota,$current_disk_usage).
                   8940:                '</p>';
                   8941:     }
                   8942:     return;
                   8943: }
                   8944: 
                   8945: ###############################################
                   8946: 
                   8947: 
1.1136    raeburn  8948: 
                   8949: 
1.384     raeburn  8950: sub get_secgrprole_info {
                   8951:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8952:     my %sections_count = &get_sections($cdom,$cnum);
                   8953:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8954:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8955:     my @groups = sort(keys(%curr_groups));
                   8956:     my $allroles = [];
                   8957:     my $rolehash;
                   8958:     my $accesshash = {
                   8959:                      active => 'Currently has access',
                   8960:                      future => 'Will have future access',
                   8961:                      previous => 'Previously had access',
                   8962:                   };
                   8963:     if ($needroles) {
                   8964:         $rolehash = {'all' => 'all'};
1.385     albertel 8965:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8966: 	if (&Apache::lonnet::error(%user_roles)) {
                   8967: 	    undef(%user_roles);
                   8968: 	}
                   8969:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  8970:             my ($role)=split(/\:/,$item,2);
                   8971:             if ($role eq 'cr') { next; }
                   8972:             if ($role =~ /^cr/) {
                   8973:                 $$rolehash{$role} = (split('/',$role))[3];
                   8974:             } else {
                   8975:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   8976:             }
                   8977:         }
                   8978:         foreach my $key (sort(keys(%{$rolehash}))) {
                   8979:             push(@{$allroles},$key);
                   8980:         }
                   8981:         push (@{$allroles},'st');
                   8982:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   8983:     }
                   8984:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   8985: }
                   8986: 
1.555     raeburn  8987: sub user_picker {
1.994     raeburn  8988:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  8989:     my $currdom = $dom;
                   8990:     my %curr_selected = (
                   8991:                         srchin => 'dom',
1.580     raeburn  8992:                         srchby => 'lastname',
1.555     raeburn  8993:                       );
                   8994:     my $srchterm;
1.625     raeburn  8995:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  8996:         if ($srch->{'srchby'} ne '') {
                   8997:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   8998:         }
                   8999:         if ($srch->{'srchin'} ne '') {
                   9000:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9001:         }
                   9002:         if ($srch->{'srchtype'} ne '') {
                   9003:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9004:         }
                   9005:         if ($srch->{'srchdomain'} ne '') {
                   9006:             $currdom = $srch->{'srchdomain'};
                   9007:         }
                   9008:         $srchterm = $srch->{'srchterm'};
                   9009:     }
                   9010:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  9011:                     'usr'       => 'Search criteria',
1.563     raeburn  9012:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9013:                     'uname'     => 'username',
                   9014:                     'lastname'  => 'last name',
1.555     raeburn  9015:                     'lastfirst' => 'last name, first name',
1.558     albertel 9016:                     'crs'       => 'in this course',
1.576     raeburn  9017:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9018:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9019:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9020:                     'exact'     => 'is',
                   9021:                     'contains'  => 'contains',
1.569     raeburn  9022:                     'begins'    => 'begins with',
1.571     raeburn  9023:                     'youm'      => "You must include some text to search for.",
                   9024:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9025:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9026:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9027:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9028:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9029:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9030:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9031:                                        );
1.563     raeburn  9032:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9033:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9034: 
                   9035:     my @srchins = ('crs','dom','alc','instd');
                   9036: 
                   9037:     foreach my $option (@srchins) {
                   9038:         # FIXME 'alc' option unavailable until 
                   9039:         #       loncreateuser::print_user_query_page()
                   9040:         #       has been completed.
                   9041:         next if ($option eq 'alc');
1.880     raeburn  9042:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9043:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9044:         if ($curr_selected{'srchin'} eq $option) {
                   9045:             $srchinsel .= ' 
                   9046:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9047:         } else {
                   9048:             $srchinsel .= '
                   9049:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9050:         }
1.555     raeburn  9051:     }
1.563     raeburn  9052:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9053: 
                   9054:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9055:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9056:         if ($curr_selected{'srchby'} eq $option) {
                   9057:             $srchbysel .= '
                   9058:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9059:         } else {
                   9060:             $srchbysel .= '
                   9061:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9062:          }
                   9063:     }
                   9064:     $srchbysel .= "\n  </select>\n";
                   9065: 
                   9066:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9067:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9068:         if ($curr_selected{'srchtype'} eq $option) {
                   9069:             $srchtypesel .= '
                   9070:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9071:         } else {
                   9072:             $srchtypesel .= '
                   9073:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9074:         }
                   9075:     }
                   9076:     $srchtypesel .= "\n  </select>\n";
                   9077: 
1.558     albertel 9078:     my ($newuserscript,$new_user_create);
1.994     raeburn  9079:     my $context_dom = $env{'request.role.domain'};
                   9080:     if ($context eq 'requestcrs') {
                   9081:         if ($env{'form.coursedom'} ne '') { 
                   9082:             $context_dom = $env{'form.coursedom'};
                   9083:         }
                   9084:     }
1.556     raeburn  9085:     if ($forcenewuser) {
1.576     raeburn  9086:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9087:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9088:                 if ($cancreate) {
                   9089:                     $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>';
                   9090:                 } else {
1.799     bisitz   9091:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9092:                     my %usertypetext = (
                   9093:                         official   => 'institutional',
                   9094:                         unofficial => 'non-institutional',
                   9095:                     );
1.799     bisitz   9096:                     $new_user_create = '<p class="LC_warning">'
                   9097:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9098:                                       .' '
                   9099:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9100:                                           ,'<a href="'.$helplink.'">','</a>')
                   9101:                                       .'</p><br />';
1.627     raeburn  9102:                 }
1.576     raeburn  9103:             }
                   9104:         }
                   9105: 
1.556     raeburn  9106:         $newuserscript = <<"ENDSCRIPT";
                   9107: 
1.570     raeburn  9108: function setSearch(createnew,callingForm) {
1.556     raeburn  9109:     if (createnew == 1) {
1.570     raeburn  9110:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9111:             if (callingForm.srchby.options[i].value == 'uname') {
                   9112:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9113:             }
                   9114:         }
1.570     raeburn  9115:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9116:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9117: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9118:             }
                   9119:         }
1.570     raeburn  9120:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9121:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9122:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9123:             }
                   9124:         }
1.570     raeburn  9125:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9126:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9127:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9128:             }
                   9129:         }
                   9130:     }
                   9131: }
                   9132: ENDSCRIPT
1.558     albertel 9133: 
1.556     raeburn  9134:     }
                   9135: 
1.555     raeburn  9136:     my $output = <<"END_BLOCK";
1.556     raeburn  9137: <script type="text/javascript">
1.824     bisitz   9138: // <![CDATA[
1.570     raeburn  9139: function validateEntry(callingForm) {
1.558     albertel 9140: 
1.556     raeburn  9141:     var checkok = 1;
1.558     albertel 9142:     var srchin;
1.570     raeburn  9143:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9144: 	if ( callingForm.srchin[i].checked ) {
                   9145: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9146: 	}
                   9147:     }
                   9148: 
1.570     raeburn  9149:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9150:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9151:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9152:     var srchterm =  callingForm.srchterm.value;
                   9153:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9154:     var msg = "";
                   9155: 
                   9156:     if (srchterm == "") {
                   9157:         checkok = 0;
1.571     raeburn  9158:         msg += "$lt{'youm'}\\n";
1.556     raeburn  9159:     }
                   9160: 
1.569     raeburn  9161:     if (srchtype== 'begins') {
                   9162:         if (srchterm.length < 2) {
                   9163:             checkok = 0;
1.571     raeburn  9164:             msg += "$lt{'thte'}\\n";
1.569     raeburn  9165:         }
                   9166:     }
                   9167: 
1.556     raeburn  9168:     if (srchtype== 'contains') {
                   9169:         if (srchterm.length < 3) {
                   9170:             checkok = 0;
1.571     raeburn  9171:             msg += "$lt{'thet'}\\n";
1.556     raeburn  9172:         }
                   9173:     }
                   9174:     if (srchin == 'instd') {
                   9175:         if (srchdomain == '') {
                   9176:             checkok = 0;
1.571     raeburn  9177:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  9178:         }
                   9179:     }
                   9180:     if (srchin == 'dom') {
                   9181:         if (srchdomain == '') {
                   9182:             checkok = 0;
1.571     raeburn  9183:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  9184:         }
                   9185:     }
                   9186:     if (srchby == 'lastfirst') {
                   9187:         if (srchterm.indexOf(",") == -1) {
                   9188:             checkok = 0;
1.571     raeburn  9189:             msg += "$lt{'whus'}\\n";
1.556     raeburn  9190:         }
                   9191:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9192:             checkok = 0;
1.571     raeburn  9193:             msg += "$lt{'whse'}\\n";
1.556     raeburn  9194:         }
                   9195:     }
                   9196:     if (checkok == 0) {
1.571     raeburn  9197:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  9198:         return;
                   9199:     }
                   9200:     if (checkok == 1) {
1.570     raeburn  9201:         callingForm.submit();
1.556     raeburn  9202:     }
                   9203: }
                   9204: 
                   9205: $newuserscript
                   9206: 
1.824     bisitz   9207: // ]]>
1.556     raeburn  9208: </script>
1.558     albertel 9209: 
                   9210: $new_user_create
                   9211: 
1.555     raeburn  9212: END_BLOCK
1.558     albertel 9213: 
1.876     raeburn  9214:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   9215:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   9216:                $domform.
                   9217:                &Apache::lonhtmlcommon::row_closure().
                   9218:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   9219:                $srchbysel.
                   9220:                $srchtypesel. 
                   9221:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9222:                $srchinsel.
                   9223:                &Apache::lonhtmlcommon::row_closure(1). 
                   9224:                &Apache::lonhtmlcommon::end_pick_box().
                   9225:                '<br />';
1.555     raeburn  9226:     return $output;
                   9227: }
                   9228: 
1.612     raeburn  9229: sub user_rule_check {
1.615     raeburn  9230:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  9231:     my $response;
                   9232:     if (ref($usershash) eq 'HASH') {
                   9233:         foreach my $user (keys(%{$usershash})) {
                   9234:             my ($uname,$udom) = split(/:/,$user);
                   9235:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  9236:             my ($id,$newuser);
1.612     raeburn  9237:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  9238:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  9239:                 $id = $usershash->{$user}->{'id'};
                   9240:             }
                   9241:             my $inst_response;
                   9242:             if (ref($checks) eq 'HASH') {
                   9243:                 if (defined($checks->{'username'})) {
1.615     raeburn  9244:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  9245:                         &Apache::lonnet::get_instuser($udom,$uname);
                   9246:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  9247:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  9248:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   9249:                 }
1.615     raeburn  9250:             } else {
                   9251:                 ($inst_response,%{$inst_results->{$user}}) =
                   9252:                     &Apache::lonnet::get_instuser($udom,$uname);
                   9253:                 return;
1.612     raeburn  9254:             }
1.615     raeburn  9255:             if (!$got_rules->{$udom}) {
1.612     raeburn  9256:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9257:                                                   ['usercreation'],$udom);
                   9258:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  9259:                     foreach my $item ('username','id') {
1.612     raeburn  9260:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9261:                             $$curr_rules{$udom}{$item} = 
                   9262:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  9263:                         }
                   9264:                     }
                   9265:                 }
1.615     raeburn  9266:                 $got_rules->{$udom} = 1;  
1.585     raeburn  9267:             }
1.612     raeburn  9268:             foreach my $item (keys(%{$checks})) {
                   9269:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9270:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9271:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   9272:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   9273:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9274:                                 if ($rule_check{$rule}) {
                   9275:                                     $$rulematch{$user}{$item} = $rule;
                   9276:                                     if ($inst_response eq 'ok') {
1.615     raeburn  9277:                                         if (ref($inst_results) eq 'HASH') {
                   9278:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9279:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9280:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   9281:                                                 }
1.612     raeburn  9282:                                             }
                   9283:                                         }
1.615     raeburn  9284:                                     }
                   9285:                                     last;
1.585     raeburn  9286:                                 }
                   9287:                             }
                   9288:                         }
                   9289:                     }
                   9290:                 }
                   9291:             }
                   9292:         }
                   9293:     }
1.612     raeburn  9294:     return;
                   9295: }
                   9296: 
                   9297: sub user_rule_formats {
                   9298:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9299:     my %text = ( 
                   9300:                  'username' => 'Usernames',
                   9301:                  'id'       => 'IDs',
                   9302:                );
                   9303:     my $output;
                   9304:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9305:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9306:         if (@{$ruleorder} > 0) {
1.1102    raeburn  9307:             $output = '<br />'.
                   9308:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9309:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9310:                       ' <ul>';
1.612     raeburn  9311:             foreach my $rule (@{$ruleorder}) {
                   9312:                 if (ref($curr_rules) eq 'ARRAY') {
                   9313:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9314:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9315:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9316:                                         $rules->{$rule}{'desc'}.'</li>';
                   9317:                         }
                   9318:                     }
                   9319:                 }
                   9320:             }
                   9321:             $output .= '</ul>';
                   9322:         }
                   9323:     }
                   9324:     return $output;
                   9325: }
                   9326: 
                   9327: sub instrule_disallow_msg {
1.615     raeburn  9328:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9329:     my $response;
                   9330:     my %text = (
                   9331:                   item   => 'username',
                   9332:                   items  => 'usernames',
                   9333:                   match  => 'matches',
                   9334:                   do     => 'does',
                   9335:                   action => 'a username',
                   9336:                   one    => 'one',
                   9337:                );
                   9338:     if ($count > 1) {
                   9339:         $text{'item'} = 'usernames';
                   9340:         $text{'match'} ='match';
                   9341:         $text{'do'} = 'do';
                   9342:         $text{'action'} = 'usernames',
                   9343:         $text{'one'} = 'ones';
                   9344:     }
                   9345:     if ($checkitem eq 'id') {
                   9346:         $text{'items'} = 'IDs';
                   9347:         $text{'item'} = 'ID';
                   9348:         $text{'action'} = 'an ID';
1.615     raeburn  9349:         if ($count > 1) {
                   9350:             $text{'item'} = 'IDs';
                   9351:             $text{'action'} = 'IDs';
                   9352:         }
1.612     raeburn  9353:     }
1.674     bisitz   9354:     $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  9355:     if ($mode eq 'upload') {
                   9356:         if ($checkitem eq 'username') {
                   9357:             $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'}.");
                   9358:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9359:             $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  9360:         }
1.669     raeburn  9361:     } elsif ($mode eq 'selfcreate') {
                   9362:         if ($checkitem eq 'id') {
                   9363:             $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.");
                   9364:         }
1.615     raeburn  9365:     } else {
                   9366:         if ($checkitem eq 'username') {
                   9367:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9368:         } elsif ($checkitem eq 'id') {
                   9369:             $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.");
                   9370:         }
1.612     raeburn  9371:     }
                   9372:     return $response;
1.585     raeburn  9373: }
                   9374: 
1.624     raeburn  9375: sub personal_data_fieldtitles {
                   9376:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9377:                         id => 'Student/Employee ID',
                   9378:                         permanentemail => 'E-mail address',
                   9379:                         lastname => 'Last Name',
                   9380:                         firstname => 'First Name',
                   9381:                         middlename => 'Middle Name',
                   9382:                         generation => 'Generation',
                   9383:                         gen => 'Generation',
1.765     raeburn  9384:                         inststatus => 'Affiliation',
1.624     raeburn  9385:                    );
                   9386:     return %fieldtitles;
                   9387: }
                   9388: 
1.642     raeburn  9389: sub sorted_inst_types {
                   9390:     my ($dom) = @_;
                   9391:     my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9392:     my $othertitle = &mt('All users');
                   9393:     if ($env{'request.course.id'}) {
1.668     raeburn  9394:         $othertitle  = &mt('Any users');
1.642     raeburn  9395:     }
                   9396:     my @types;
                   9397:     if (ref($order) eq 'ARRAY') {
                   9398:         @types = @{$order};
                   9399:     }
                   9400:     if (@types == 0) {
                   9401:         if (ref($usertypes) eq 'HASH') {
                   9402:             @types = sort(keys(%{$usertypes}));
                   9403:         }
                   9404:     }
                   9405:     if (keys(%{$usertypes}) > 0) {
                   9406:         $othertitle = &mt('Other users');
                   9407:     }
                   9408:     return ($othertitle,$usertypes,\@types);
                   9409: }
                   9410: 
1.645     raeburn  9411: sub get_institutional_codes {
                   9412:     my ($settings,$allcourses,$LC_code) = @_;
                   9413: # Get complete list of course sections to update
                   9414:     my @currsections = ();
                   9415:     my @currxlists = ();
                   9416:     my $coursecode = $$settings{'internal.coursecode'};
                   9417: 
                   9418:     if ($$settings{'internal.sectionnums'} ne '') {
                   9419:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9420:     }
                   9421: 
                   9422:     if ($$settings{'internal.crosslistings'} ne '') {
                   9423:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9424:     }
                   9425: 
                   9426:     if (@currxlists > 0) {
                   9427:         foreach (@currxlists) {
                   9428:             if (m/^([^:]+):(\w*)$/) {
                   9429:                 unless (grep/^$1$/,@{$allcourses}) {
                   9430:                     push @{$allcourses},$1;
                   9431:                     $$LC_code{$1} = $2;
                   9432:                 }
                   9433:             }
                   9434:         }
                   9435:     }
                   9436:  
                   9437:     if (@currsections > 0) {
                   9438:         foreach (@currsections) {
                   9439:             if (m/^(\w+):(\w*)$/) {
                   9440:                 my $sec = $coursecode.$1;
                   9441:                 my $lc_sec = $2;
                   9442:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9443:                     push @{$allcourses},$sec;
                   9444:                     $$LC_code{$sec} = $lc_sec;
                   9445:                 }
                   9446:             }
                   9447:         }
                   9448:     }
                   9449:     return;
                   9450: }
                   9451: 
1.971     raeburn  9452: sub get_standard_codeitems {
                   9453:     return ('Year','Semester','Department','Number','Section');
                   9454: }
                   9455: 
1.112     bowersj2 9456: =pod
                   9457: 
1.780     raeburn  9458: =head1 Slot Helpers
                   9459: 
                   9460: =over 4
                   9461: 
                   9462: =item * sorted_slots()
                   9463: 
1.1040    raeburn  9464: Sorts an array of slot names in order of an optional sort key,
                   9465: default sort is by slot start time (earliest first). 
1.780     raeburn  9466: 
                   9467: Inputs:
                   9468: 
                   9469: =over 4
                   9470: 
                   9471: slotsarr  - Reference to array of unsorted slot names.
                   9472: 
                   9473: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9474: 
1.1040    raeburn  9475: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9476: 
1.549     albertel 9477: =back
                   9478: 
1.780     raeburn  9479: Returns:
                   9480: 
                   9481: =over 4
                   9482: 
1.1040    raeburn  9483: sorted   - An array of slot names sorted by a specified sort key 
                   9484:            (default sort key is start time of the slot).
1.780     raeburn  9485: 
                   9486: =back
                   9487: 
                   9488: =cut
                   9489: 
                   9490: 
                   9491: sub sorted_slots {
1.1040    raeburn  9492:     my ($slotsarr,$slots,$sortkey) = @_;
                   9493:     if ($sortkey eq '') {
                   9494:         $sortkey = 'starttime';
                   9495:     }
1.780     raeburn  9496:     my @sorted;
                   9497:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9498:         @sorted =
                   9499:             sort {
                   9500:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9501:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9502:                      }
                   9503:                      if (ref($slots->{$a})) { return -1;}
                   9504:                      if (ref($slots->{$b})) { return 1;}
                   9505:                      return 0;
                   9506:                  } @{$slotsarr};
                   9507:     }
                   9508:     return @sorted;
                   9509: }
                   9510: 
1.1040    raeburn  9511: =pod
                   9512: 
                   9513: =item * get_future_slots()
                   9514: 
                   9515: Inputs:
                   9516: 
                   9517: =over 4
                   9518: 
                   9519: cnum - course number
                   9520: 
                   9521: cdom - course domain
                   9522: 
                   9523: now - current UNIX time
                   9524: 
                   9525: symb - optional symb
                   9526: 
                   9527: =back
                   9528: 
                   9529: Returns:
                   9530: 
                   9531: =over 4
                   9532: 
                   9533: sorted_reservable - ref to array of student_schedulable slots currently 
                   9534:                     reservable, ordered by end date of reservation period.
                   9535: 
                   9536: reservable_now - ref to hash of student_schedulable slots currently
                   9537:                  reservable.
                   9538: 
                   9539:     Keys in inner hash are:
                   9540:     (a) symb: either blank or symb to which slot use is restricted.
                   9541:     (b) endreserve: end date of reservation period. 
                   9542: 
                   9543: sorted_future - ref to array of student_schedulable slots reservable in
                   9544:                 the future, ordered by start date of reservation period.
                   9545: 
                   9546: future_reservable - ref to hash of student_schedulable slots reservable
                   9547:                     in the future.
                   9548: 
                   9549:     Keys in inner hash are:
                   9550:     (a) symb: either blank or symb to which slot use is restricted.
                   9551:     (b) startreserve:  start date of reservation period.
                   9552: 
                   9553: =back
                   9554: 
                   9555: =cut
                   9556: 
                   9557: sub get_future_slots {
                   9558:     my ($cnum,$cdom,$now,$symb) = @_;
                   9559:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9560:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9561:     foreach my $slot (keys(%slots)) {
                   9562:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9563:         if ($symb) {
                   9564:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9565:                      ($slots{$slot}->{'symb'} ne $symb));
                   9566:         }
                   9567:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9568:             ($slots{$slot}->{'endtime'} > $now)) {
                   9569:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9570:                 my $userallowed = 0;
                   9571:                 if ($slots{$slot}->{'allowedsections'}) {
                   9572:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9573:                     if (!defined($env{'request.role.sec'})
                   9574:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9575:                         $userallowed=1;
                   9576:                     } else {
                   9577:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9578:                             $userallowed=1;
                   9579:                         }
                   9580:                     }
                   9581:                     unless ($userallowed) {
                   9582:                         if (defined($env{'request.course.groups'})) {
                   9583:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9584:                             foreach my $group (@groups) {
                   9585:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9586:                                     $userallowed=1;
                   9587:                                     last;
                   9588:                                 }
                   9589:                             }
                   9590:                         }
                   9591:                     }
                   9592:                 }
                   9593:                 if ($slots{$slot}->{'allowedusers'}) {
                   9594:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9595:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9596:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9597:                         $userallowed = 1;
                   9598:                     }
                   9599:                 }
                   9600:                 next unless($userallowed);
                   9601:             }
                   9602:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9603:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9604:             my $symb = $slots{$slot}->{'symb'};
                   9605:             if (($startreserve < $now) &&
                   9606:                 (!$endreserve || $endreserve > $now)) {
                   9607:                 my $lastres = $endreserve;
                   9608:                 if (!$lastres) {
                   9609:                     $lastres = $slots{$slot}->{'starttime'};
                   9610:                 }
                   9611:                 $reservable_now{$slot} = {
                   9612:                                            symb       => $symb,
                   9613:                                            endreserve => $lastres
                   9614:                                          };
                   9615:             } elsif (($startreserve > $now) &&
                   9616:                      (!$endreserve || $endreserve > $startreserve)) {
                   9617:                 $future_reservable{$slot} = {
                   9618:                                               symb         => $symb,
                   9619:                                               startreserve => $startreserve
                   9620:                                             };
                   9621:             }
                   9622:         }
                   9623:     }
                   9624:     my @unsorted_reservable = keys(%reservable_now);
                   9625:     if (@unsorted_reservable > 0) {
                   9626:         @sorted_reservable = 
                   9627:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9628:     }
                   9629:     my @unsorted_future = keys(%future_reservable);
                   9630:     if (@unsorted_future > 0) {
                   9631:         @sorted_future =
                   9632:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9633:     }
                   9634:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9635: }
1.780     raeburn  9636: 
                   9637: =pod
                   9638: 
1.1057    foxr     9639: =back
                   9640: 
1.549     albertel 9641: =head1 HTTP Helpers
                   9642: 
                   9643: =over 4
                   9644: 
1.648     raeburn  9645: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9646: 
1.258     albertel 9647: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9648: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9649: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9650: 
                   9651: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9652: $possible_names is an ref to an array of form element names.  As an example:
                   9653: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9654: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9655: 
                   9656: =cut
1.1       albertel 9657: 
1.6       albertel 9658: sub get_unprocessed_cgi {
1.25      albertel 9659:   my ($query,$possible_names)= @_;
1.26      matthew  9660:   # $Apache::lonxml::debug=1;
1.356     albertel 9661:   foreach my $pair (split(/&/,$query)) {
                   9662:     my ($name, $value) = split(/=/,$pair);
1.369     www      9663:     $name = &unescape($name);
1.25      albertel 9664:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9665:       $value =~ tr/+/ /;
                   9666:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9667:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9668:     }
1.16      harris41 9669:   }
1.6       albertel 9670: }
                   9671: 
1.112     bowersj2 9672: =pod
                   9673: 
1.648     raeburn  9674: =item * &cacheheader() 
1.112     bowersj2 9675: 
                   9676: returns cache-controlling header code
                   9677: 
                   9678: =cut
                   9679: 
1.7       albertel 9680: sub cacheheader {
1.258     albertel 9681:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9682:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9683:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9684:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9685:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9686:     return $output;
1.7       albertel 9687: }
                   9688: 
1.112     bowersj2 9689: =pod
                   9690: 
1.648     raeburn  9691: =item * &no_cache($r) 
1.112     bowersj2 9692: 
                   9693: specifies header code to not have cache
                   9694: 
                   9695: =cut
                   9696: 
1.9       albertel 9697: sub no_cache {
1.216     albertel 9698:     my ($r) = @_;
                   9699:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9700: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9701:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9702:     $r->no_cache(1);
                   9703:     $r->header_out("Expires" => $date);
                   9704:     $r->header_out("Pragma" => "no-cache");
1.123     www      9705: }
                   9706: 
                   9707: sub content_type {
1.181     albertel 9708:     my ($r,$type,$charset) = @_;
1.299     foxr     9709:     if ($r) {
                   9710: 	#  Note that printout.pl calls this with undef for $r.
                   9711: 	&no_cache($r);
                   9712:     }
1.258     albertel 9713:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9714:     unless ($charset) {
                   9715: 	$charset=&Apache::lonlocal::current_encoding;
                   9716:     }
                   9717:     if ($charset) { $type.='; charset='.$charset; }
                   9718:     if ($r) {
                   9719: 	$r->content_type($type);
                   9720:     } else {
                   9721: 	print("Content-type: $type\n\n");
                   9722:     }
1.9       albertel 9723: }
1.25      albertel 9724: 
1.112     bowersj2 9725: =pod
                   9726: 
1.648     raeburn  9727: =item * &add_to_env($name,$value) 
1.112     bowersj2 9728: 
1.258     albertel 9729: adds $name to the %env hash with value
1.112     bowersj2 9730: $value, if $name already exists, the entry is converted to an array
                   9731: reference and $value is added to the array.
                   9732: 
                   9733: =cut
                   9734: 
1.25      albertel 9735: sub add_to_env {
                   9736:   my ($name,$value)=@_;
1.258     albertel 9737:   if (defined($env{$name})) {
                   9738:     if (ref($env{$name})) {
1.25      albertel 9739:       #already have multiple values
1.258     albertel 9740:       push(@{ $env{$name} },$value);
1.25      albertel 9741:     } else {
                   9742:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9743:       my $first=$env{$name};
                   9744:       undef($env{$name});
                   9745:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9746:     }
                   9747:   } else {
1.258     albertel 9748:     $env{$name}=$value;
1.25      albertel 9749:   }
1.31      albertel 9750: }
1.149     albertel 9751: 
                   9752: =pod
                   9753: 
1.648     raeburn  9754: =item * &get_env_multiple($name) 
1.149     albertel 9755: 
1.258     albertel 9756: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9757: values may be defined and end up as an array ref.
                   9758: 
                   9759: returns an array of values
                   9760: 
                   9761: =cut
                   9762: 
                   9763: sub get_env_multiple {
                   9764:     my ($name) = @_;
                   9765:     my @values;
1.258     albertel 9766:     if (defined($env{$name})) {
1.149     albertel 9767:         # exists is it an array
1.258     albertel 9768:         if (ref($env{$name})) {
                   9769:             @values=@{ $env{$name} };
1.149     albertel 9770:         } else {
1.258     albertel 9771:             $values[0]=$env{$name};
1.149     albertel 9772:         }
                   9773:     }
                   9774:     return(@values);
                   9775: }
                   9776: 
1.660     raeburn  9777: sub ask_for_embedded_content {
                   9778:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9779:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085    raeburn  9780:         %currsubfile,%unused,$rem);
1.1071    raeburn  9781:     my $counter = 0;
                   9782:     my $numnew = 0;
1.987     raeburn  9783:     my $numremref = 0;
                   9784:     my $numinvalid = 0;
                   9785:     my $numpathchg = 0;
                   9786:     my $numexisting = 0;
1.1071    raeburn  9787:     my $numunused = 0;
                   9788:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
                   9789:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path);
                   9790:     my $heading = &mt('Upload embedded files');
                   9791:     my $buttontext = &mt('Upload');
                   9792: 
1.1123    raeburn  9793:     my ($navmap,$cdom,$cnum);
1.1085    raeburn  9794:     if ($env{'request.course.id'}) {
1.1123    raeburn  9795:         if ($actionurl eq '/adm/dependencies') {
                   9796:             $navmap = Apache::lonnavmaps::navmap->new();
                   9797:         }
                   9798:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9799:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085    raeburn  9800:     }
1.1123    raeburn  9801:     if (($actionurl eq '/adm/portfolio') || 
                   9802:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  9803:         my $current_path='/';
                   9804:         if ($env{'form.currentpath'}) {
                   9805:             $current_path = $env{'form.currentpath'};
                   9806:         }
                   9807:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123    raeburn  9808:             $udom = $cdom;
                   9809:             $uname = $cnum;
1.984     raeburn  9810:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9811:         } else {
                   9812:             $udom = $env{'user.domain'};
                   9813:             $uname = $env{'user.name'};
                   9814:             $url = '/userfiles/portfolio';
                   9815:         }
1.987     raeburn  9816:         $toplevel = $url.'/';
1.984     raeburn  9817:         $url .= $current_path;
                   9818:         $getpropath = 1;
1.987     raeburn  9819:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9820:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9821:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9822:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9823:         $toplevel = $url;
1.984     raeburn  9824:         if ($rest ne '') {
1.987     raeburn  9825:             $url .= $rest;
                   9826:         }
                   9827:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9828:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9829:             $url = $args->{'docs_url'};
                   9830:             $toplevel = $url;
1.1084    raeburn  9831:             if ($args->{'context'} eq 'paste') {
                   9832:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9833:                 ($path) = 
                   9834:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9835:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9836:                 $fileloc =~ s{^/}{};
                   9837:             }
1.1071    raeburn  9838:         }
1.1084    raeburn  9839:     } elsif ($actionurl eq '/adm/dependencies')  {
1.1071    raeburn  9840:         if ($env{'request.course.id'} ne '') {
                   9841:             if (ref($args) eq 'HASH') {
                   9842:                 $url = $args->{'docs_url'};
                   9843:                 $title = $args->{'docs_title'};
1.1126    raeburn  9844:                 $toplevel = $url; 
                   9845:                 unless ($toplevel =~ m{^/}) {
                   9846:                     $toplevel = "/$url";
                   9847:                 }
1.1085    raeburn  9848:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126    raeburn  9849:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   9850:                     $path = $1;
                   9851:                 } else {
                   9852:                     ($path) =
                   9853:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9854:                 }
1.1071    raeburn  9855:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9856:                 $fileloc =~ s{^/}{};
                   9857:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9858:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9859:             }
1.987     raeburn  9860:         }
1.1123    raeburn  9861:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9862:         $udom = $cdom;
                   9863:         $uname = $cnum;
                   9864:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   9865:         $toplevel = $url;
                   9866:         $path = $url;
                   9867:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   9868:         $fileloc =~ s{^/}{};
1.987     raeburn  9869:     }
1.1126    raeburn  9870:     foreach my $file (keys(%{$allfiles})) {
                   9871:         my $embed_file;
                   9872:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   9873:             $embed_file = $1;
                   9874:         } else {
                   9875:             $embed_file = $file;
                   9876:         }
1.987     raeburn  9877:         my $absolutepath;
1.1147    raeburn  9878:         my $cleaned_file = &clean_path($embed_file);
                   9879:         if ($cleaned_file =~ m{^\w+://}) {
                   9880:             $newfiles{$cleaned_file} = 1;
                   9881:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9882:         } else {
                   9883:             if ($embed_file =~ m{^/}) {
                   9884:                 $absolutepath = $embed_file;
                   9885:             }
1.1147    raeburn  9886:             if ($cleaned_file =~ m{/}) {
                   9887:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  9888:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9889:                 my $item = $fname;
                   9890:                 if ($path ne '') {
                   9891:                     $item = $path.'/'.$fname;
                   9892:                     $subdependencies{$path}{$fname} = 1;
                   9893:                 } else {
                   9894:                     $dependencies{$item} = 1;
                   9895:                 }
                   9896:                 if ($absolutepath) {
                   9897:                     $mapping{$item} = $absolutepath;
                   9898:                 } else {
                   9899:                     $mapping{$item} = $embed_file;
                   9900:                 }
                   9901:             } else {
                   9902:                 $dependencies{$embed_file} = 1;
                   9903:                 if ($absolutepath) {
1.1147    raeburn  9904:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  9905:                 } else {
1.1147    raeburn  9906:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9907:                 }
                   9908:             }
1.984     raeburn  9909:         }
                   9910:     }
1.1071    raeburn  9911:     my $dirptr = 16384;
1.984     raeburn  9912:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9913:         $currsubfile{$path} = {};
1.1123    raeburn  9914:         if (($actionurl eq '/adm/portfolio') || 
                   9915:             ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9916:             my ($sublistref,$listerror) =
                   9917:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9918:             if (ref($sublistref) eq 'ARRAY') {
                   9919:                 foreach my $line (@{$sublistref}) {
                   9920:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9921:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9922:                 }
1.984     raeburn  9923:             }
1.987     raeburn  9924:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9925:             if (opendir(my $dir,$url.'/'.$path)) {
                   9926:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9927:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9928:             }
1.1084    raeburn  9929:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9930:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  9931:                   ($args->{'context'} eq 'paste')) ||
                   9932:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  9933:             if ($env{'request.course.id'} ne '') {
1.1123    raeburn  9934:                 my $dir;
                   9935:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9936:                     $dir = $fileloc;
                   9937:                 } else {
                   9938:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9939:                 }
1.1071    raeburn  9940:                 if ($dir ne '') {
                   9941:                     my ($sublistref,$listerror) =
                   9942:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9943:                     if (ref($sublistref) eq 'ARRAY') {
                   9944:                         foreach my $line (@{$sublistref}) {
                   9945:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9946:                                 undef,$mtime)=split(/\&/,$line,12);
                   9947:                             unless (($testdir&$dirptr) ||
                   9948:                                     ($file_name =~ /^\.\.?$/)) {
                   9949:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9950:                             }
                   9951:                         }
                   9952:                     }
                   9953:                 }
1.984     raeburn  9954:             }
                   9955:         }
                   9956:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  9957:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  9958:                 my $item = $path.'/'.$file;
                   9959:                 unless ($mapping{$item} eq $item) {
                   9960:                     $pathchanges{$item} = 1;
                   9961:                 }
                   9962:                 $existing{$item} = 1;
                   9963:                 $numexisting ++;
                   9964:             } else {
                   9965:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  9966:             }
                   9967:         }
1.1071    raeburn  9968:         if ($actionurl eq '/adm/dependencies') {
                   9969:             foreach my $path (keys(%currsubfile)) {
                   9970:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   9971:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   9972:                          unless ($subdependencies{$path}{$file}) {
1.1085    raeburn  9973:                              next if (($rem ne '') &&
                   9974:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   9975:                                        (ref($navmap) &&
                   9976:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   9977:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   9978:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  9979:                              $unused{$path.'/'.$file} = 1; 
                   9980:                          }
                   9981:                     }
                   9982:                 }
                   9983:             }
                   9984:         }
1.984     raeburn  9985:     }
1.987     raeburn  9986:     my %currfile;
1.1123    raeburn  9987:     if (($actionurl eq '/adm/portfolio') ||
                   9988:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  9989:         my ($dirlistref,$listerror) =
                   9990:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   9991:         if (ref($dirlistref) eq 'ARRAY') {
                   9992:             foreach my $line (@{$dirlistref}) {
                   9993:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   9994:                 $currfile{$file_name} = 1;
                   9995:             }
1.984     raeburn  9996:         }
1.987     raeburn  9997:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9998:         if (opendir(my $dir,$url)) {
1.987     raeburn  9999:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10000:             map {$currfile{$_} = 1;} @dir_list;
                   10001:         }
1.1084    raeburn  10002:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10003:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123    raeburn  10004:               ($args->{'context'} eq 'paste')) ||
                   10005:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10006:         if ($env{'request.course.id'} ne '') {
                   10007:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10008:             if ($dir ne '') {
                   10009:                 my ($dirlistref,$listerror) =
                   10010:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10011:                 if (ref($dirlistref) eq 'ARRAY') {
                   10012:                     foreach my $line (@{$dirlistref}) {
                   10013:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10014:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10015:                         unless (($testdir&$dirptr) ||
                   10016:                                 ($file_name =~ /^\.\.?$/)) {
                   10017:                             $currfile{$file_name} = [$size,$mtime];
                   10018:                         }
                   10019:                     }
                   10020:                 }
                   10021:             }
                   10022:         }
1.984     raeburn  10023:     }
                   10024:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10025:         if (exists($currfile{$file})) {
1.987     raeburn  10026:             unless ($mapping{$file} eq $file) {
                   10027:                 $pathchanges{$file} = 1;
                   10028:             }
                   10029:             $existing{$file} = 1;
                   10030:             $numexisting ++;
                   10031:         } else {
1.984     raeburn  10032:             $newfiles{$file} = 1;
                   10033:         }
                   10034:     }
1.1071    raeburn  10035:     foreach my $file (keys(%currfile)) {
                   10036:         unless (($file eq $filename) ||
                   10037:                 ($file eq $filename.'.bak') ||
                   10038:                 ($dependencies{$file})) {
1.1085    raeburn  10039:             if ($actionurl eq '/adm/dependencies') {
1.1126    raeburn  10040:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10041:                     next if (($rem ne '') &&
                   10042:                              (($env{"httpref.$rem".$file} ne '') ||
                   10043:                               (ref($navmap) &&
                   10044:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10045:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10046:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10047:                 }
1.1085    raeburn  10048:             }
1.1071    raeburn  10049:             $unused{$file} = 1;
                   10050:         }
                   10051:     }
1.1084    raeburn  10052:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10053:         ($args->{'context'} eq 'paste')) {
                   10054:         $counter = scalar(keys(%existing));
                   10055:         $numpathchg = scalar(keys(%pathchanges));
1.1123    raeburn  10056:         return ($output,$counter,$numpathchg,\%existing);
                   10057:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") && 
                   10058:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10059:         $counter = scalar(keys(%existing));
                   10060:         $numpathchg = scalar(keys(%pathchanges));
                   10061:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084    raeburn  10062:     }
1.984     raeburn  10063:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10064:         if ($actionurl eq '/adm/dependencies') {
                   10065:             next if ($embed_file =~ m{^\w+://});
                   10066:         }
1.660     raeburn  10067:         $upload_output .= &start_data_table_row().
1.1123    raeburn  10068:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10069:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10070:         unless ($mapping{$embed_file} eq $embed_file) {
1.1123    raeburn  10071:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10072:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10073:         }
1.1123    raeburn  10074:         $upload_output .= '</td>';
1.1071    raeburn  10075:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1123    raeburn  10076:             $upload_output.='<td align="right">'.
                   10077:                             '<span class="LC_info LC_fontsize_medium">'.
                   10078:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10079:             $numremref++;
1.660     raeburn  10080:         } elsif ($args->{'error_on_invalid_names'}
                   10081:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123    raeburn  10082:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10083:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10084:             $numinvalid++;
1.660     raeburn  10085:         } else {
1.1123    raeburn  10086:             $upload_output .= '<td>'.
                   10087:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10088:                                                      $embed_file,\%mapping,
1.1071    raeburn  10089:                                                      $allfiles,$codebase,'upload');
                   10090:             $counter ++;
                   10091:             $numnew ++;
1.987     raeburn  10092:         }
                   10093:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10094:     }
                   10095:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10096:         if ($actionurl eq '/adm/dependencies') {
                   10097:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10098:             $modify_output .= &start_data_table_row().
                   10099:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10100:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10101:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10102:                               '<td>'.$size.'</td>'.
                   10103:                               '<td>'.$mtime.'</td>'.
                   10104:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10105:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10106:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10107:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10108:                               &embedded_file_element('upload_embedded',$counter,
                   10109:                                                      $embed_file,\%mapping,
                   10110:                                                      $allfiles,$codebase,'modify').
                   10111:                               '</div></td>'.
                   10112:                               &end_data_table_row()."\n";
                   10113:             $counter ++;
                   10114:         } else {
                   10115:             $upload_output .= &start_data_table_row().
1.1123    raeburn  10116:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10117:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10118:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10119:                               &Apache::loncommon::end_data_table_row()."\n";
                   10120:         }
                   10121:     }
                   10122:     my $delidx = $counter;
                   10123:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10124:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10125:         $delete_output .= &start_data_table_row().
                   10126:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10127:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10128:                           '<td>'.$size.'</td>'.
                   10129:                           '<td>'.$mtime.'</td>'.
                   10130:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10131:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10132:                           &embedded_file_element('upload_embedded',$delidx,
                   10133:                                                  $oldfile,\%mapping,$allfiles,
                   10134:                                                  $codebase,'delete').'</td>'.
                   10135:                           &end_data_table_row()."\n"; 
                   10136:         $numunused ++;
                   10137:         $delidx ++;
1.987     raeburn  10138:     }
                   10139:     if ($upload_output) {
                   10140:         $upload_output = &start_data_table().
                   10141:                          $upload_output.
                   10142:                          &end_data_table()."\n";
                   10143:     }
1.1071    raeburn  10144:     if ($modify_output) {
                   10145:         $modify_output = &start_data_table().
                   10146:                          &start_data_table_header_row().
                   10147:                          '<th>'.&mt('File').'</th>'.
                   10148:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10149:                          '<th>'.&mt('Modified').'</th>'.
                   10150:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10151:                          &end_data_table_header_row().
                   10152:                          $modify_output.
                   10153:                          &end_data_table()."\n";
                   10154:     }
                   10155:     if ($delete_output) {
                   10156:         $delete_output = &start_data_table().
                   10157:                          &start_data_table_header_row().
                   10158:                          '<th>'.&mt('File').'</th>'.
                   10159:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10160:                          '<th>'.&mt('Modified').'</th>'.
                   10161:                          '<th>'.&mt('Delete?').'</th>'.
                   10162:                          &end_data_table_header_row().
                   10163:                          $delete_output.
                   10164:                          &end_data_table()."\n";
                   10165:     }
1.987     raeburn  10166:     my $applies = 0;
                   10167:     if ($numremref) {
                   10168:         $applies ++;
                   10169:     }
                   10170:     if ($numinvalid) {
                   10171:         $applies ++;
                   10172:     }
                   10173:     if ($numexisting) {
                   10174:         $applies ++;
                   10175:     }
1.1071    raeburn  10176:     if ($counter || $numunused) {
1.987     raeburn  10177:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10178:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10179:                   $state.'<h3>'.$heading.'</h3>'; 
                   10180:         if ($actionurl eq '/adm/dependencies') {
                   10181:             if ($numnew) {
                   10182:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10183:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10184:                            $upload_output.'<br />'."\n";
                   10185:             }
                   10186:             if ($numexisting) {
                   10187:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10188:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10189:                            $modify_output.'<br />'."\n";
                   10190:                            $buttontext = &mt('Save changes');
                   10191:             }
                   10192:             if ($numunused) {
                   10193:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10194:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10195:                            $delete_output.'<br />'."\n";
                   10196:                            $buttontext = &mt('Save changes');
                   10197:             }
                   10198:         } else {
                   10199:             $output .= $upload_output.'<br />'."\n";
                   10200:         }
                   10201:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10202:                    $counter.'" />'."\n";
                   10203:         if ($actionurl eq '/adm/dependencies') { 
                   10204:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10205:                        $numnew.'" />'."\n";
                   10206:         } elsif ($actionurl eq '') {
1.987     raeburn  10207:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10208:         }
                   10209:     } elsif ($applies) {
                   10210:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10211:         if ($applies > 1) {
                   10212:             $output .=  
1.1123    raeburn  10213:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10214:             if ($numremref) {
                   10215:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10216:             }
                   10217:             if ($numinvalid) {
                   10218:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10219:             }
                   10220:             if ($numexisting) {
                   10221:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10222:             }
                   10223:             $output .= '</ul><br />';
                   10224:         } elsif ($numremref) {
                   10225:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10226:         } elsif ($numinvalid) {
                   10227:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10228:         } elsif ($numexisting) {
                   10229:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10230:         }
                   10231:         $output .= $upload_output.'<br />';
                   10232:     }
                   10233:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10234:     $chgcount = $counter;
1.987     raeburn  10235:     if (keys(%pathchanges) > 0) {
                   10236:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10237:             if ($counter) {
1.987     raeburn  10238:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10239:                                                   $embed_file,\%mapping,
1.1071    raeburn  10240:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10241:             } else {
                   10242:                 $pathchange_output .= 
                   10243:                     &start_data_table_row().
                   10244:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10245:                     $chgcount.'" checked="checked" /></td>'.
                   10246:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10247:                     '<td>'.$embed_file.
                   10248:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10249:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10250:                     '</td>'.&end_data_table_row();
1.660     raeburn  10251:             }
1.987     raeburn  10252:             $numpathchg ++;
                   10253:             $chgcount ++;
1.660     raeburn  10254:         }
                   10255:     }
1.1127    raeburn  10256:     if (($counter) || ($numunused)) {
1.987     raeburn  10257:         if ($numpathchg) {
                   10258:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10259:                        $numpathchg.'" />'."\n";
                   10260:         }
                   10261:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10262:             ($actionurl eq '/adm/imsimport')) {
                   10263:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10264:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10265:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10266:         } elsif ($actionurl eq '/adm/dependencies') {
                   10267:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10268:         }
1.1123    raeburn  10269:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10270:     } elsif ($numpathchg) {
                   10271:         my %pathchange = ();
                   10272:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10273:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10274:             $output .= '<p>'.&mt('or').'</p>'; 
1.1123    raeburn  10275:         }
1.987     raeburn  10276:     }
1.1071    raeburn  10277:     return ($output,$counter,$numpathchg);
1.987     raeburn  10278: }
                   10279: 
1.1147    raeburn  10280: =pod
                   10281: 
                   10282: =item * clean_path($name)
                   10283: 
                   10284: Performs clean-up of directories, subdirectories and filename in an
                   10285: embedded object, referenced in an HTML file which is being uploaded
                   10286: to a course or portfolio, where 
                   10287: "Upload embedded images/multimedia files if HTML file" checkbox was
                   10288: checked.
                   10289: 
                   10290: Clean-up is similar to replacements in lonnet::clean_filename()
                   10291: except each / between sub-directory and next level is preserved.
                   10292: 
                   10293: =cut
                   10294: 
                   10295: sub clean_path {
                   10296:     my ($embed_file) = @_;
                   10297:     $embed_file =~s{^/+}{};
                   10298:     my @contents;
                   10299:     if ($embed_file =~ m{/}) {
                   10300:         @contents = split(/\//,$embed_file);
                   10301:     } else {
                   10302:         @contents = ($embed_file);
                   10303:     }
                   10304:     my $lastidx = scalar(@contents)-1;
                   10305:     for (my $i=0; $i<=$lastidx; $i++) { 
                   10306:         $contents[$i]=~s{\\}{/}g;
                   10307:         $contents[$i]=~s/\s+/\_/g;
                   10308:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   10309:         if ($i == $lastidx) {
                   10310:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   10311:         }
                   10312:     }
                   10313:     if ($lastidx > 0) {
                   10314:         return join('/',@contents);
                   10315:     } else {
                   10316:         return $contents[0];
                   10317:     }
                   10318: }
                   10319: 
1.987     raeburn  10320: sub embedded_file_element {
1.1071    raeburn  10321:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10322:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10323:                    (ref($codebase) eq 'HASH'));
                   10324:     my $output;
1.1071    raeburn  10325:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10326:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10327:     }
                   10328:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10329:                &escape($embed_file).'" />';
                   10330:     unless (($context eq 'upload_embedded') && 
                   10331:             ($mapping->{$embed_file} eq $embed_file)) {
                   10332:         $output .='
                   10333:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10334:     }
                   10335:     my $attrib;
                   10336:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10337:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10338:     }
                   10339:     $output .=
                   10340:         "\n\t\t".
                   10341:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10342:         $attrib.'" />';
                   10343:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10344:         $output .=
                   10345:             "\n\t\t".
                   10346:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10347:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10348:     }
1.987     raeburn  10349:     return $output;
1.660     raeburn  10350: }
                   10351: 
1.1071    raeburn  10352: sub get_dependency_details {
                   10353:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10354:     my ($size,$mtime,$showsize,$showmtime);
                   10355:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10356:         if ($embed_file =~ m{/}) {
                   10357:             my ($path,$fname) = split(/\//,$embed_file);
                   10358:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10359:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10360:             }
                   10361:         } else {
                   10362:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10363:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10364:             }
                   10365:         }
                   10366:         $showsize = $size/1024.0;
                   10367:         $showsize = sprintf("%.1f",$showsize);
                   10368:         if ($mtime > 0) {
                   10369:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10370:         }
                   10371:     }
                   10372:     return ($showsize,$showmtime);
                   10373: }
                   10374: 
                   10375: sub ask_embedded_js {
                   10376:     return <<"END";
                   10377: <script type="text/javascript"">
                   10378: // <![CDATA[
                   10379: function toggleBrowse(counter) {
                   10380:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10381:     var fileid = document.getElementById('embedded_item_'+counter);
                   10382:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10383:     if (chkboxid.checked == true) {
                   10384:         uploaddivid.style.display='block';
                   10385:     } else {
                   10386:         uploaddivid.style.display='none';
                   10387:         fileid.value = '';
                   10388:     }
                   10389: }
                   10390: // ]]>
                   10391: </script>
                   10392: 
                   10393: END
                   10394: }
                   10395: 
1.661     raeburn  10396: sub upload_embedded {
                   10397:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10398:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10399:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10400:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10401:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10402:         my $orig_uploaded_filename =
                   10403:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10404:         foreach my $type ('orig','ref','attrib','codebase') {
                   10405:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10406:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10407:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10408:             }
                   10409:         }
1.661     raeburn  10410:         my ($path,$fname) =
                   10411:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10412:         # no path, whole string is fname
                   10413:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10414:         $fname = &Apache::lonnet::clean_filename($fname);
                   10415:         # See if there is anything left
                   10416:         next if ($fname eq '');
                   10417: 
                   10418:         # Check if file already exists as a file or directory.
                   10419:         my ($state,$msg);
                   10420:         if ($context eq 'portfolio') {
                   10421:             my $port_path = $dirpath;
                   10422:             if ($group ne '') {
                   10423:                 $port_path = "groups/$group/$port_path";
                   10424:             }
1.987     raeburn  10425:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10426:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10427:                                               $dir_root,$port_path,$disk_quota,
                   10428:                                               $current_disk_usage,$uname,$udom);
                   10429:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10430:                 || $state eq 'file_locked') {
1.661     raeburn  10431:                 $output .= $msg;
                   10432:                 next;
                   10433:             }
                   10434:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10435:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10436:             if ($state eq 'exists') {
                   10437:                 $output .= $msg;
                   10438:                 next;
                   10439:             }
                   10440:         }
                   10441:         # Check if extension is valid
                   10442:         if (($fname =~ /\.(\w+)$/) &&
                   10443:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.987     raeburn  10444:             $output .= &mt('Invalid file extension ([_1]) - reserved for LONCAPA use - rename the file with a different extension and re-upload. ',$1).'<br />';
1.661     raeburn  10445:             next;
                   10446:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10447:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10448:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10449:             next;
                   10450:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120    bisitz   10451:             $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  10452:             next;
                   10453:         }
                   10454:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123    raeburn  10455:         my $subdir = $path;
                   10456:         $subdir =~ s{/+$}{};
1.661     raeburn  10457:         if ($context eq 'portfolio') {
1.984     raeburn  10458:             my $result;
                   10459:             if ($state eq 'existingfile') {
                   10460:                 $result=
                   10461:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123    raeburn  10462:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  10463:             } else {
1.984     raeburn  10464:                 $result=
                   10465:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10466:                                                     $dirpath.
1.1123    raeburn  10467:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  10468:                 if ($result !~ m|^/uploaded/|) {
                   10469:                     $output .= '<span class="LC_error">'
                   10470:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10471:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10472:                                .'</span><br />';
                   10473:                     next;
                   10474:                 } else {
1.987     raeburn  10475:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10476:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10477:                 }
1.661     raeburn  10478:             }
1.1123    raeburn  10479:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126    raeburn  10480:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   10481:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  10482:             my $result =
1.1126    raeburn  10483:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  10484:             if ($result !~ m|^/uploaded/|) {
                   10485:                 $output .= '<span class="LC_error">'
                   10486:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10487:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10488:                            .'</span><br />';
                   10489:                     next;
                   10490:             } else {
                   10491:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10492:                            $path.$fname.'</span>').'<br />';
1.1125    raeburn  10493:                 if ($context eq 'syllabus') {
                   10494:                     &Apache::lonnet::make_public_indefinitely($result);
                   10495:                 }
1.987     raeburn  10496:             }
1.661     raeburn  10497:         } else {
                   10498: # Save the file
                   10499:             my $target = $env{'form.embedded_item_'.$i};
                   10500:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10501:             my $dest = $fullpath.$fname;
                   10502:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10503:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10504:             my $count;
                   10505:             my $filepath = $dir_root;
1.1027    raeburn  10506:             foreach my $subdir (@parts) {
                   10507:                 $filepath .= "/$subdir";
                   10508:                 if (!-e $filepath) {
1.661     raeburn  10509:                     mkdir($filepath,0770);
                   10510:                 }
                   10511:             }
                   10512:             my $fh;
                   10513:             if (!open($fh,'>'.$dest)) {
                   10514:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10515:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10516:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10517:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10518:                            '</span><br />';
                   10519:             } else {
                   10520:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10521:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10522:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10523:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10524:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10525:                               '</span><br />';
                   10526:                 } else {
1.987     raeburn  10527:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10528:                                $url.'</span>').'<br />';
                   10529:                     unless ($context eq 'testbank') {
                   10530:                         $footer .= &mt('View embedded file: [_1]',
                   10531:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10532:                     }
                   10533:                 }
                   10534:                 close($fh);
                   10535:             }
                   10536:         }
                   10537:         if ($env{'form.embedded_ref_'.$i}) {
                   10538:             $pathchange{$i} = 1;
                   10539:         }
                   10540:     }
                   10541:     if ($output) {
                   10542:         $output = '<p>'.$output.'</p>';
                   10543:     }
                   10544:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10545:     $returnflag = 'ok';
1.1071    raeburn  10546:     my $numpathchgs = scalar(keys(%pathchange));
                   10547:     if ($numpathchgs > 0) {
1.987     raeburn  10548:         if ($context eq 'portfolio') {
                   10549:             $output .= '<p>'.&mt('or').'</p>';
                   10550:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10551:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10552:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10553:             $returnflag = 'modify_orightml';
                   10554:         }
                   10555:     }
1.1071    raeburn  10556:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10557: }
                   10558: 
                   10559: sub modify_html_form {
                   10560:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10561:     my $end = 0;
                   10562:     my $modifyform;
                   10563:     if ($context eq 'upload_embedded') {
                   10564:         return unless (ref($pathchange) eq 'HASH');
                   10565:         if ($env{'form.number_embedded_items'}) {
                   10566:             $end += $env{'form.number_embedded_items'};
                   10567:         }
                   10568:         if ($env{'form.number_pathchange_items'}) {
                   10569:             $end += $env{'form.number_pathchange_items'};
                   10570:         }
                   10571:         if ($end) {
                   10572:             for (my $i=0; $i<$end; $i++) {
                   10573:                 if ($i < $env{'form.number_embedded_items'}) {
                   10574:                     next unless($pathchange->{$i});
                   10575:                 }
                   10576:                 $modifyform .=
                   10577:                     &start_data_table_row().
                   10578:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10579:                     'checked="checked" /></td>'.
                   10580:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10581:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10582:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10583:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10584:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10585:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10586:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10587:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10588:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10589:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10590:                     &end_data_table_row();
1.1071    raeburn  10591:             }
1.987     raeburn  10592:         }
                   10593:     } else {
                   10594:         $modifyform = $pathchgtable;
                   10595:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10596:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10597:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10598:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10599:         }
                   10600:     }
                   10601:     if ($modifyform) {
1.1071    raeburn  10602:         if ($actionurl eq '/adm/dependencies') {
                   10603:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10604:         }
1.987     raeburn  10605:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10606:                '<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".
                   10607:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10608:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10609:                '</ol></p>'."\n".'<p>'.
                   10610:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10611:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10612:                &start_data_table()."\n".
                   10613:                &start_data_table_header_row().
                   10614:                '<th>'.&mt('Change?').'</th>'.
                   10615:                '<th>'.&mt('Current reference').'</th>'.
                   10616:                '<th>'.&mt('Required reference').'</th>'.
                   10617:                &end_data_table_header_row()."\n".
                   10618:                $modifyform.
                   10619:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10620:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10621:                '</form>'."\n";
                   10622:     }
                   10623:     return;
                   10624: }
                   10625: 
                   10626: sub modify_html_refs {
1.1123    raeburn  10627:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  10628:     my $container;
                   10629:     if ($context eq 'portfolio') {
                   10630:         $container = $env{'form.container'};
                   10631:     } elsif ($context eq 'coursedoc') {
                   10632:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10633:     } elsif ($context eq 'manage_dependencies') {
                   10634:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10635:         $container = "/$container";
1.1123    raeburn  10636:     } elsif ($context eq 'syllabus') {
                   10637:         $container = $url;
1.987     raeburn  10638:     } else {
1.1027    raeburn  10639:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10640:     }
                   10641:     my (%allfiles,%codebase,$output,$content);
                   10642:     my @changes = &get_env_multiple('form.namechange');
1.1126    raeburn  10643:     unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071    raeburn  10644:         if (wantarray) {
                   10645:             return ('',0,0); 
                   10646:         } else {
                   10647:             return;
                   10648:         }
                   10649:     }
                   10650:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  10651:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  10652:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10653:             if (wantarray) {
                   10654:                 return ('',0,0);
                   10655:             } else {
                   10656:                 return;
                   10657:             }
                   10658:         } 
1.987     raeburn  10659:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10660:         if ($content eq '-1') {
                   10661:             if (wantarray) {
                   10662:                 return ('',0,0);
                   10663:             } else {
                   10664:                 return;
                   10665:             }
                   10666:         }
1.987     raeburn  10667:     } else {
1.1071    raeburn  10668:         unless ($container =~ /^\Q$dir_root\E/) {
                   10669:             if (wantarray) {
                   10670:                 return ('',0,0);
                   10671:             } else {
                   10672:                 return;
                   10673:             }
                   10674:         } 
1.987     raeburn  10675:         if (open(my $fh,"<$container")) {
                   10676:             $content = join('', <$fh>);
                   10677:             close($fh);
                   10678:         } else {
1.1071    raeburn  10679:             if (wantarray) {
                   10680:                 return ('',0,0);
                   10681:             } else {
                   10682:                 return;
                   10683:             }
1.987     raeburn  10684:         }
                   10685:     }
                   10686:     my ($count,$codebasecount) = (0,0);
                   10687:     my $mm = new File::MMagic;
                   10688:     my $mime_type = $mm->checktype_contents($content);
                   10689:     if ($mime_type eq 'text/html') {
                   10690:         my $parse_result = 
                   10691:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10692:                                                     \%codebase,\$content);
                   10693:         if ($parse_result eq 'ok') {
                   10694:             foreach my $i (@changes) {
                   10695:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10696:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10697:                 if ($allfiles{$ref}) {
                   10698:                     my $newname =  $orig;
                   10699:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10700:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10701:                     if ($attrib_regexp =~ /:/) {
                   10702:                         $attrib_regexp =~ s/\:/|/g;
                   10703:                     }
                   10704:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10705:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10706:                         $count += $numchg;
1.1123    raeburn  10707:                         $allfiles{$newname} = $allfiles{$ref};
1.1148    raeburn  10708:                         delete($allfiles{$ref});
1.987     raeburn  10709:                     }
                   10710:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10711:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10712:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10713:                         $codebasecount ++;
                   10714:                     }
                   10715:                 }
                   10716:             }
1.1123    raeburn  10717:             my $skiprewrites;
1.987     raeburn  10718:             if ($count || $codebasecount) {
                   10719:                 my $saveresult;
1.1071    raeburn  10720:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1123    raeburn  10721:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  10722:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10723:                     if ($url eq $container) {
                   10724:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10725:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10726:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10727:                                             $fname.'</span>').'</p>';
1.987     raeburn  10728:                     } else {
                   10729:                          $output = '<p class="LC_error">'.
                   10730:                                    &mt('Error: update failed for: [_1].',
                   10731:                                    '<span class="LC_filename">'.
                   10732:                                    $container.'</span>').'</p>';
                   10733:                     }
1.1123    raeburn  10734:                     if ($context eq 'syllabus') {
                   10735:                         unless ($saveresult eq 'ok') {
                   10736:                             $skiprewrites = 1;
                   10737:                         }
                   10738:                     }
1.987     raeburn  10739:                 } else {
                   10740:                     if (open(my $fh,">$container")) {
                   10741:                         print $fh $content;
                   10742:                         close($fh);
                   10743:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10744:                                   $count,'<span class="LC_filename">'.
                   10745:                                   $container.'</span>').'</p>';
1.661     raeburn  10746:                     } else {
1.987     raeburn  10747:                          $output = '<p class="LC_error">'.
                   10748:                                    &mt('Error: could not update [_1].',
                   10749:                                    '<span class="LC_filename">'.
                   10750:                                    $container.'</span>').'</p>';
1.661     raeburn  10751:                     }
                   10752:                 }
                   10753:             }
1.1123    raeburn  10754:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   10755:                 my ($actionurl,$state);
                   10756:                 $actionurl = "/public/$udom/$uname/syllabus";
                   10757:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   10758:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   10759:                                               \%codebase,
                   10760:                                               {'context' => 'rewrites',
                   10761:                                                'ignore_remote_references' => 1,});
                   10762:                 if (ref($mapping) eq 'HASH') {
                   10763:                     my $rewrites = 0;
                   10764:                     foreach my $key (keys(%{$mapping})) {
                   10765:                         next if ($key =~ m{^https?://});
                   10766:                         my $ref = $mapping->{$key};
                   10767:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   10768:                         my $attrib;
                   10769:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   10770:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   10771:                         }
                   10772:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10773:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10774:                             $rewrites += $numchg;
                   10775:                         }
                   10776:                     }
                   10777:                     if ($rewrites) {
                   10778:                         my $saveresult; 
                   10779:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10780:                         if ($url eq $container) {
                   10781:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   10782:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   10783:                                             $count,'<span class="LC_filename">'.
                   10784:                                             $fname.'</span>').'</p>';
                   10785:                         } else {
                   10786:                             $output .= '<p class="LC_error">'.
                   10787:                                        &mt('Error: could not update links in [_1].',
                   10788:                                        '<span class="LC_filename">'.
                   10789:                                        $container.'</span>').'</p>';
                   10790: 
                   10791:                         }
                   10792:                     }
                   10793:                 }
                   10794:             }
1.987     raeburn  10795:         } else {
                   10796:             &logthis('Failed to parse '.$container.
                   10797:                      ' to modify references: '.$parse_result);
1.661     raeburn  10798:         }
                   10799:     }
1.1071    raeburn  10800:     if (wantarray) {
                   10801:         return ($output,$count,$codebasecount);
                   10802:     } else {
                   10803:         return $output;
                   10804:     }
1.661     raeburn  10805: }
                   10806: 
                   10807: sub check_for_existing {
                   10808:     my ($path,$fname,$element) = @_;
                   10809:     my ($state,$msg);
                   10810:     if (-d $path.'/'.$fname) {
                   10811:         $state = 'exists';
                   10812:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10813:     } elsif (-e $path.'/'.$fname) {
                   10814:         $state = 'exists';
                   10815:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10816:     }
                   10817:     if ($state eq 'exists') {
                   10818:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10819:     }
                   10820:     return ($state,$msg);
                   10821: }
                   10822: 
                   10823: sub check_for_upload {
                   10824:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10825:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10826:     my $filesize = length($env{'form.'.$element});
                   10827:     if (!$filesize) {
                   10828:         my $msg = '<span class="LC_error">'.
                   10829:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10830:                       '<span class="LC_filename">'.$fname.'</span>',
                   10831:                       $filesize).'<br />'.
1.1007    raeburn  10832:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10833:                   '</span>';
                   10834:         return ('zero_bytes',$msg);
                   10835:     }
                   10836:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10837:     my $getpropath = 1;
1.1021    raeburn  10838:     my ($dirlistref,$listerror) =
                   10839:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10840:     my $found_file = 0;
                   10841:     my $locked_file = 0;
1.991     raeburn  10842:     my @lockers;
                   10843:     my $navmap;
                   10844:     if ($env{'request.course.id'}) {
                   10845:         $navmap = Apache::lonnavmaps::navmap->new();
                   10846:     }
1.1021    raeburn  10847:     if (ref($dirlistref) eq 'ARRAY') {
                   10848:         foreach my $line (@{$dirlistref}) {
                   10849:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10850:             if ($file_name eq $fname){
                   10851:                 $file_name = $path.$file_name;
                   10852:                 if ($group ne '') {
                   10853:                     $file_name = $group.$file_name;
                   10854:                 }
                   10855:                 $found_file = 1;
                   10856:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10857:                     foreach my $lock (@lockers) {
                   10858:                         if (ref($lock) eq 'ARRAY') {
                   10859:                             my ($symb,$crsid) = @{$lock};
                   10860:                             if ($crsid eq $env{'request.course.id'}) {
                   10861:                                 if (ref($navmap)) {
                   10862:                                     my $res = $navmap->getBySymb($symb);
                   10863:                                     foreach my $part (@{$res->parts()}) { 
                   10864:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10865:                                         unless (($slot_status == $res->RESERVED) ||
                   10866:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10867:                                             $locked_file = 1;
                   10868:                                         }
1.991     raeburn  10869:                                     }
1.1021    raeburn  10870:                                 } else {
                   10871:                                     $locked_file = 1;
1.991     raeburn  10872:                                 }
                   10873:                             } else {
                   10874:                                 $locked_file = 1;
                   10875:                             }
                   10876:                         }
1.1021    raeburn  10877:                    }
                   10878:                 } else {
                   10879:                     my @info = split(/\&/,$rest);
                   10880:                     my $currsize = $info[6]/1000;
                   10881:                     if ($currsize < $filesize) {
                   10882:                         my $extra = $filesize - $currsize;
                   10883:                         if (($current_disk_usage + $extra) > $disk_quota) {
                   10884:                             my $msg = '<span class="LC_error">'.
                   10885:                                       &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.',
                   10886:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</span>'.
                   10887:                                       '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10888:                                                    $disk_quota,$current_disk_usage);
                   10889:                             return ('will_exceed_quota',$msg);
                   10890:                         }
1.984     raeburn  10891:                     }
                   10892:                 }
1.661     raeburn  10893:             }
                   10894:         }
                   10895:     }
                   10896:     if (($current_disk_usage + $filesize) > $disk_quota){
                   10897:         my $msg = '<span class="LC_error">'.
                   10898:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</span>'.
                   10899:                   '<br />'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage);
                   10900:         return ('will_exceed_quota',$msg);
                   10901:     } elsif ($found_file) {
                   10902:         if ($locked_file) {
                   10903:             my $msg = '<span class="LC_error">';
                   10904:             $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>');
                   10905:             $msg .= '</span><br />';
                   10906:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10907:             return ('file_locked',$msg);
                   10908:         } else {
                   10909:             my $msg = '<span class="LC_error">';
1.984     raeburn  10910:             $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  10911:             $msg .= '</span>';
1.984     raeburn  10912:             return ('existingfile',$msg);
1.661     raeburn  10913:         }
                   10914:     }
                   10915: }
                   10916: 
1.987     raeburn  10917: sub check_for_traversal {
                   10918:     my ($path,$url,$toplevel) = @_;
                   10919:     my @parts=split(/\//,$path);
                   10920:     my $cleanpath;
                   10921:     my $fullpath = $url;
                   10922:     for (my $i=0;$i<@parts;$i++) {
                   10923:         next if ($parts[$i] eq '.');
                   10924:         if ($parts[$i] eq '..') {
                   10925:             $fullpath =~ s{([^/]+/)$}{};
                   10926:         } else {
                   10927:             $fullpath .= $parts[$i].'/';
                   10928:         }
                   10929:     }
                   10930:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10931:         $cleanpath = $1;
                   10932:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10933:         my $curr_toprel = $1;
                   10934:         my @parts = split(/\//,$curr_toprel);
                   10935:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10936:         my @urlparts = split(/\//,$url_toprel);
                   10937:         my $doubledots;
                   10938:         my $startdiff = -1;
                   10939:         for (my $i=0; $i<@urlparts; $i++) {
                   10940:             if ($startdiff == -1) {
                   10941:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10942:                     $startdiff = $i;
                   10943:                     $doubledots .= '../';
                   10944:                 }
                   10945:             } else {
                   10946:                 $doubledots .= '../';
                   10947:             }
                   10948:         }
                   10949:         if ($startdiff > -1) {
                   10950:             $cleanpath = $doubledots;
                   10951:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10952:                 $cleanpath .= $parts[$i].'/';
                   10953:             }
                   10954:         }
                   10955:     }
                   10956:     $cleanpath =~ s{(/)$}{};
                   10957:     return $cleanpath;
                   10958: }
1.31      albertel 10959: 
1.1053    raeburn  10960: sub is_archive_file {
                   10961:     my ($mimetype) = @_;
                   10962:     if (($mimetype eq 'application/octet-stream') ||
                   10963:         ($mimetype eq 'application/x-stuffit') ||
                   10964:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   10965:         return 1;
                   10966:     }
                   10967:     return;
                   10968: }
                   10969: 
                   10970: sub decompress_form {
1.1065    raeburn  10971:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  10972:     my %lt = &Apache::lonlocal::texthash (
                   10973:         this => 'This file is an archive file.',
1.1067    raeburn  10974:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  10975:         itsc => 'Its contents are as follows:',
1.1053    raeburn  10976:         youm => 'You may wish to extract its contents.',
                   10977:         extr => 'Extract contents',
1.1067    raeburn  10978:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   10979:         proa => 'Process automatically?',
1.1053    raeburn  10980:         yes  => 'Yes',
                   10981:         no   => 'No',
1.1067    raeburn  10982:         fold => 'Title for folder containing movie',
                   10983:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  10984:     );
1.1065    raeburn  10985:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  10986:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  10987:     my $info = &list_archive_contents($fileloc,\@paths);
                   10988:     if (@paths) {
                   10989:         foreach my $path (@paths) {
                   10990:             $path =~ s{^/}{};
1.1067    raeburn  10991:             if ($path =~ m{^([^/]+)/$}) {
                   10992:                 $topdir = $1;
                   10993:             }
1.1065    raeburn  10994:             if ($path =~ m{^([^/]+)/}) {
                   10995:                 $toplevel{$1} = $path;
                   10996:             } else {
                   10997:                 $toplevel{$path} = $path;
                   10998:             }
                   10999:         }
                   11000:     }
1.1067    raeburn  11001:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
                   11002:         my @camtasia = ("$topdir/","$topdir/index.html",
                   11003:                         "$topdir/media/",
                   11004:                         "$topdir/media/$topdir.mp4",
                   11005:                         "$topdir/media/FirstFrame.png",
                   11006:                         "$topdir/media/player.swf",
                   11007:                         "$topdir/media/swfobject.js",
                   11008:                         "$topdir/media/expressInstall.swf");
                   11009:         my @diffs = &compare_arrays(\@paths,\@camtasia);
                   11010:         if (@diffs == 0) {
                   11011:             $is_camtasia = 1;
                   11012:         }
                   11013:     }
                   11014:     my $output;
                   11015:     if ($is_camtasia) {
                   11016:         $output = <<"ENDCAM";
                   11017: <script type="text/javascript" language="Javascript">
                   11018: // <![CDATA[
                   11019: 
                   11020: function camtasiaToggle() {
                   11021:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11022:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
                   11023:             if (document.uploaded_decompress.autoextract_camtasia[i].value == 1) {
                   11024: 
                   11025:                 document.getElementById('camtasia_titles').style.display='block';
                   11026:             } else {
                   11027:                 document.getElementById('camtasia_titles').style.display='none';
                   11028:             }
                   11029:         }
                   11030:     }
                   11031:     return;
                   11032: }
                   11033: 
                   11034: // ]]>
                   11035: </script>
                   11036: <p>$lt{'camt'}</p>
                   11037: ENDCAM
1.1065    raeburn  11038:     } else {
1.1067    raeburn  11039:         $output = '<p>'.$lt{'this'};
                   11040:         if ($info eq '') {
                   11041:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11042:         } else {
                   11043:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11044:                        '<div><pre>'.$info.'</pre></div>';
                   11045:         }
1.1065    raeburn  11046:     }
1.1067    raeburn  11047:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11048:     my $duplicates;
                   11049:     my $num = 0;
                   11050:     if (ref($dirlist) eq 'ARRAY') {
                   11051:         foreach my $item (@{$dirlist}) {
                   11052:             if (ref($item) eq 'ARRAY') {
                   11053:                 if (exists($toplevel{$item->[0]})) {
                   11054:                     $duplicates .= 
                   11055:                         &start_data_table_row().
                   11056:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11057:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11058:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11059:                         'value="1" />'.&mt('Yes').'</label>'.
                   11060:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11061:                         '<td>'.$item->[0].'</td>';
                   11062:                     if ($item->[2]) {
                   11063:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11064:                     } else {
                   11065:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11066:                     }
                   11067:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11068:                                    '<td>'.
                   11069:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11070:                                    '</td>'.
                   11071:                                    &end_data_table_row();
                   11072:                     $num ++;
                   11073:                 }
                   11074:             }
                   11075:         }
                   11076:     }
                   11077:     my $itemcount;
                   11078:     if (@paths > 0) {
                   11079:         $itemcount = scalar(@paths);
                   11080:     } else {
                   11081:         $itemcount = 1;
                   11082:     }
1.1067    raeburn  11083:     if ($is_camtasia) {
                   11084:         $output .= $lt{'auto'}.'<br />'.
                   11085:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
                   11086:                    '<input type="radio" name="autoextract_camtasia" value="1" onclick="javascript:camtasiaToggle();" checked="checked" />'.
                   11087:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11088:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11089:                    $lt{'no'}.'</label></span><br />'.
                   11090:                    '<div id="camtasia_titles" style="display:block">'.
                   11091:                    &Apache::lonhtmlcommon::start_pick_box().
                   11092:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11093:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11094:                    &Apache::lonhtmlcommon::row_closure().
                   11095:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11096:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11097:                    &Apache::lonhtmlcommon::row_closure(1).
                   11098:                    &Apache::lonhtmlcommon::end_pick_box().
                   11099:                    '</div>';
                   11100:     }
1.1065    raeburn  11101:     $output .= 
                   11102:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11103:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11104:         "\n";
1.1065    raeburn  11105:     if ($duplicates ne '') {
                   11106:         $output .= '<p><span class="LC_warning">'.
                   11107:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11108:                    &start_data_table().
                   11109:                    &start_data_table_header_row().
                   11110:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11111:                    '<th>'.&mt('Name').'</th>'.
                   11112:                    '<th>'.&mt('Type').'</th>'.
                   11113:                    '<th>'.&mt('Size').'</th>'.
                   11114:                    '<th>'.&mt('Last modified').'</th>'.
                   11115:                    &end_data_table_header_row().
                   11116:                    $duplicates.
                   11117:                    &end_data_table().
                   11118:                    '</p>';
                   11119:     }
1.1067    raeburn  11120:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11121:     if (ref($hiddenelements) eq 'HASH') {
                   11122:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11123:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11124:         }
                   11125:     }
                   11126:     $output .= <<"END";
1.1067    raeburn  11127: <br />
1.1053    raeburn  11128: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11129: </form>
                   11130: $noextract
                   11131: END
                   11132:     return $output;
                   11133: }
                   11134: 
1.1065    raeburn  11135: sub decompression_utility {
                   11136:     my ($program) = @_;
                   11137:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11138:     my $location;
                   11139:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11140:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11141:                          '/usr/sbin/') {
                   11142:             if (-x $dir.$program) {
                   11143:                 $location = $dir.$program;
                   11144:                 last;
                   11145:             }
                   11146:         }
                   11147:     }
                   11148:     return $location;
                   11149: }
                   11150: 
                   11151: sub list_archive_contents {
                   11152:     my ($file,$pathsref) = @_;
                   11153:     my (@cmd,$output);
                   11154:     my $needsregexp;
                   11155:     if ($file =~ /\.zip$/) {
                   11156:         @cmd = (&decompression_utility('unzip'),"-l");
                   11157:         $needsregexp = 1;
                   11158:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11159:              ($file =~ /\.tgz$/)) {
                   11160:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11161:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11162:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11163:     } elsif ($file =~ m|\.tar$|) {
                   11164:         @cmd = (&decompression_utility('tar'),"-tf");
                   11165:     }
                   11166:     if (@cmd) {
                   11167:         undef($!);
                   11168:         undef($@);
                   11169:         if (open(my $fh,"-|", @cmd, $file)) {
                   11170:             while (my $line = <$fh>) {
                   11171:                 $output .= $line;
                   11172:                 chomp($line);
                   11173:                 my $item;
                   11174:                 if ($needsregexp) {
                   11175:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11176:                 } else {
                   11177:                     $item = $line;
                   11178:                 }
                   11179:                 if ($item ne '') {
                   11180:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11181:                         push(@{$pathsref},$item);
                   11182:                     } 
                   11183:                 }
                   11184:             }
                   11185:             close($fh);
                   11186:         }
                   11187:     }
                   11188:     return $output;
                   11189: }
                   11190: 
1.1053    raeburn  11191: sub decompress_uploaded_file {
                   11192:     my ($file,$dir) = @_;
                   11193:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11194:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11195:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11196:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11197:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11198:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11199:     my $decompressed = $env{'cgi.decompressed'};
                   11200:     &Apache::lonnet::delenv('cgi.file');
                   11201:     &Apache::lonnet::delenv('cgi.dir');
                   11202:     &Apache::lonnet::delenv('cgi.decompressed');
                   11203:     return ($decompressed,$result);
                   11204: }
                   11205: 
1.1055    raeburn  11206: sub process_decompression {
                   11207:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11208:     my ($dir,$error,$warning,$output);
                   11209:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/) {
1.1120    bisitz   11210:         $error = &mt('Filename not a supported archive file type.').
                   11211:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11212:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11213:     } else {
                   11214:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11215:         if ($docuhome eq 'no_host') {
                   11216:             $error = &mt('Could not determine home server for course.');
                   11217:         } else {
                   11218:             my @ids=&Apache::lonnet::current_machine_ids();
                   11219:             my $currdir = "$dir_root/$destination";
                   11220:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11221:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11222:                        "$dir_root/$destination";
                   11223:             } else {
                   11224:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11225:                        "$dir_root/$docudom/$docuname/$destination";
                   11226:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11227:                     $error = &mt('Archive file not found.');
                   11228:                 }
                   11229:             }
1.1065    raeburn  11230:             my (@to_overwrite,@to_skip);
                   11231:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11232:                 my $total = $env{'form.archive_overwrite_total'};
                   11233:                 for (my $i=0; $i<$total; $i++) {
                   11234:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11235:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11236:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11237:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11238:                     }
                   11239:                 }
                   11240:             }
                   11241:             my $numskip = scalar(@to_skip);
                   11242:             if (($numskip > 0) && 
                   11243:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11244:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11245:             } elsif ($dir eq '') {
1.1055    raeburn  11246:                 $error = &mt('Directory containing archive file unavailable.');
                   11247:             } elsif (!$error) {
1.1065    raeburn  11248:                 my ($decompressed,$display);
                   11249:                 if ($numskip > 0) {
                   11250:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11251:                     mkdir("$dir/$tempdir",0755);
                   11252:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11253:                     ($decompressed,$display) = 
                   11254:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11255:                     foreach my $item (@to_skip) {
                   11256:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11257:                             if (-f "$dir/$tempdir/$item") { 
                   11258:                                 unlink("$dir/$tempdir/$item");
                   11259:                             } elsif (-d "$dir/$tempdir/$item") {
                   11260:                                 system("rm -rf $dir/$tempdir/$item");
                   11261:                             }
                   11262:                         }
                   11263:                     }
                   11264:                     system("mv $dir/$tempdir/* $dir");
                   11265:                     rmdir("$dir/$tempdir");   
                   11266:                 } else {
                   11267:                     ($decompressed,$display) = 
                   11268:                         &decompress_uploaded_file($file,$dir);
                   11269:                 }
1.1055    raeburn  11270:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11271:                     $output = '<p class="LC_info">'.
                   11272:                               &mt('Files extracted successfully from archive.').
                   11273:                               '</p>'."\n";
1.1055    raeburn  11274:                     my ($warning,$result,@contents);
                   11275:                     my ($newdirlistref,$newlisterror) =
                   11276:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11277:                                                  $docuname,1);
                   11278:                     my (%is_dir,%changes,@newitems);
                   11279:                     my $dirptr = 16384;
1.1065    raeburn  11280:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11281:                         foreach my $dir_line (@{$newdirlistref}) {
                   11282:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11283:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11284:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11285:                                 push(@newitems,$item);
                   11286:                                 if ($dirptr&$testdir) {
                   11287:                                     $is_dir{$item} = 1;
                   11288:                                 }
                   11289:                                 $changes{$item} = 1;
                   11290:                             }
                   11291:                         }
                   11292:                     }
                   11293:                     if (keys(%changes) > 0) {
                   11294:                         foreach my $item (sort(@newitems)) {
                   11295:                             if ($changes{$item}) {
                   11296:                                 push(@contents,$item);
                   11297:                             }
                   11298:                         }
                   11299:                     }
                   11300:                     if (@contents > 0) {
1.1067    raeburn  11301:                         my $wantform;
                   11302:                         unless ($env{'form.autoextract_camtasia'}) {
                   11303:                             $wantform = 1;
                   11304:                         }
1.1056    raeburn  11305:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11306:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11307:                                                                 $currdir,\%is_dir,
                   11308:                                                                 \%children,\%parent,
1.1056    raeburn  11309:                                                                 \@contents,\%dirorder,
                   11310:                                                                 \%titles,$wantform);
1.1055    raeburn  11311:                         if ($datatable ne '') {
                   11312:                             $output .= &archive_options_form('decompressed',$datatable,
                   11313:                                                              $count,$hiddenelem);
1.1065    raeburn  11314:                             my $startcount = 6;
1.1055    raeburn  11315:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11316:                                                            \%titles,\%children);
1.1055    raeburn  11317:                         }
1.1067    raeburn  11318:                         if ($env{'form.autoextract_camtasia'}) {
                   11319:                             my %displayed;
                   11320:                             my $total = 1;
                   11321:                             $env{'form.archive_directory'} = [];
                   11322:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11323:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11324:                                 $path =~ s{/$}{};
                   11325:                                 my $item;
                   11326:                                 if ($path ne '') {
                   11327:                                     $item = "$path/$titles{$i}";
                   11328:                                 } else {
                   11329:                                     $item = $titles{$i};
                   11330:                                 }
                   11331:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11332:                                 if ($item eq $contents[0]) {
                   11333:                                     push(@{$env{'form.archive_directory'}},$i);
                   11334:                                     $env{'form.archive_'.$i} = 'display';
                   11335:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11336:                                     $displayed{'folder'} = $i;
                   11337:                                 } elsif ($item eq "$contents[0]/index.html") {
                   11338:                                     $env{'form.archive_'.$i} = 'display';
                   11339:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11340:                                     $displayed{'web'} = $i;
                   11341:                                 } else {
                   11342:                                     if ($item eq "$contents[0]/media") {
                   11343:                                         push(@{$env{'form.archive_directory'}},$i);
                   11344:                                     }
                   11345:                                     $env{'form.archive_'.$i} = 'dependency';
                   11346:                                 }
                   11347:                                 $total ++;
                   11348:                             }
                   11349:                             for (my $i=1; $i<$total; $i++) {
                   11350:                                 next if ($i == $displayed{'web'});
                   11351:                                 next if ($i == $displayed{'folder'});
                   11352:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11353:                             }
                   11354:                             $env{'form.phase'} = 'decompress_cleanup';
                   11355:                             $env{'form.archivedelete'} = 1;
                   11356:                             $env{'form.archive_count'} = $total-1;
                   11357:                             $output .=
                   11358:                                 &process_extracted_files('coursedocs',$docudom,
                   11359:                                                          $docuname,$destination,
                   11360:                                                          $dir_root,$hiddenelem);
                   11361:                         }
1.1055    raeburn  11362:                     } else {
                   11363:                         $warning = &mt('No new items extracted from archive file.');
                   11364:                     }
                   11365:                 } else {
                   11366:                     $output = $display;
                   11367:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11368:                 }
                   11369:             }
                   11370:         }
                   11371:     }
                   11372:     if ($error) {
                   11373:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11374:                    $error.'</p>'."\n";
                   11375:     }
                   11376:     if ($warning) {
                   11377:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11378:     }
                   11379:     return $output;
                   11380: }
                   11381: 
                   11382: sub get_extracted {
1.1056    raeburn  11383:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11384:         $titles,$wantform) = @_;
1.1055    raeburn  11385:     my $count = 0;
                   11386:     my $depth = 0;
                   11387:     my $datatable;
1.1056    raeburn  11388:     my @hierarchy;
1.1055    raeburn  11389:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11390:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11391:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11392:     foreach my $item (@{$contents}) {
                   11393:         $count ++;
1.1056    raeburn  11394:         @{$dirorder->{$count}} = @hierarchy;
                   11395:         $titles->{$count} = $item;
1.1055    raeburn  11396:         &archive_hierarchy($depth,$count,$parent,$children);
                   11397:         if ($wantform) {
                   11398:             $datatable .= &archive_row($is_dir->{$item},$item,
                   11399:                                        $currdir,$depth,$count);
                   11400:         }
                   11401:         if ($is_dir->{$item}) {
                   11402:             $depth ++;
1.1056    raeburn  11403:             push(@hierarchy,$count);
                   11404:             $parent->{$depth} = $count;
1.1055    raeburn  11405:             $datatable .=
                   11406:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  11407:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   11408:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  11409:             $depth --;
1.1056    raeburn  11410:             pop(@hierarchy);
1.1055    raeburn  11411:         }
                   11412:     }
                   11413:     return ($count,$datatable);
                   11414: }
                   11415: 
                   11416: sub recurse_extracted_archive {
1.1056    raeburn  11417:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   11418:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  11419:     my $result='';
1.1056    raeburn  11420:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   11421:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   11422:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  11423:         return $result;
                   11424:     }
                   11425:     my $dirptr = 16384;
                   11426:     my ($newdirlistref,$newlisterror) =
                   11427:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   11428:     if (ref($newdirlistref) eq 'ARRAY') {
                   11429:         foreach my $dir_line (@{$newdirlistref}) {
                   11430:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   11431:             unless ($item =~ /^\.+$/) {
                   11432:                 $$count ++;
1.1056    raeburn  11433:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   11434:                 $titles->{$$count} = $item;
1.1055    raeburn  11435:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  11436: 
1.1055    raeburn  11437:                 my $is_dir;
                   11438:                 if ($dirptr&$testdir) {
                   11439:                     $is_dir = 1;
                   11440:                 }
                   11441:                 if ($wantform) {
                   11442:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11443:                 }
                   11444:                 if ($is_dir) {
                   11445:                     $$depth ++;
1.1056    raeburn  11446:                     push(@{$hierarchy},$$count);
                   11447:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11448:                     $result .=
                   11449:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11450:                                                    $docuname,$depth,$count,
1.1056    raeburn  11451:                                                    $hierarchy,$dirorder,$children,
                   11452:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11453:                     $$depth --;
1.1056    raeburn  11454:                     pop(@{$hierarchy});
1.1055    raeburn  11455:                 }
                   11456:             }
                   11457:         }
                   11458:     }
                   11459:     return $result;
                   11460: }
                   11461: 
                   11462: sub archive_hierarchy {
                   11463:     my ($depth,$count,$parent,$children) =@_;
                   11464:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11465:         if (exists($parent->{$depth})) {
                   11466:              $children->{$parent->{$depth}} .= $count.':';
                   11467:         }
                   11468:     }
                   11469:     return;
                   11470: }
                   11471: 
                   11472: sub archive_row {
                   11473:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11474:     my ($name) = ($item =~ m{([^/]+)$});
                   11475:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11476:                                        'display'    => 'Add as file',
1.1055    raeburn  11477:                                        'dependency' => 'Include as dependency',
                   11478:                                        'discard'    => 'Discard',
                   11479:                                       );
                   11480:     if ($is_dir) {
1.1059    raeburn  11481:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11482:     }
1.1056    raeburn  11483:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11484:     my $offset = 0;
1.1055    raeburn  11485:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11486:         $offset ++;
1.1065    raeburn  11487:         if ($action ne 'display') {
                   11488:             $offset ++;
                   11489:         }  
1.1055    raeburn  11490:         $output .= '<td><span class="LC_nobreak">'.
                   11491:                    '<label><input type="radio" name="archive_'.$count.
                   11492:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11493:         my $text = $choices{$action};
                   11494:         if ($is_dir) {
                   11495:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11496:             if ($action eq 'display') {
1.1059    raeburn  11497:                 $text = &mt('Add as folder');
1.1055    raeburn  11498:             }
1.1056    raeburn  11499:         } else {
                   11500:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11501: 
                   11502:         }
                   11503:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11504:         if ($action eq 'dependency') {
                   11505:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11506:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11507:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11508:                        '<option value=""></option>'."\n".
                   11509:                        '</select>'."\n".
                   11510:                        '</div>';
1.1059    raeburn  11511:         } elsif ($action eq 'display') {
                   11512:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11513:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11514:                        '</div>';
1.1055    raeburn  11515:         }
1.1056    raeburn  11516:         $output .= '</td>';
1.1055    raeburn  11517:     }
                   11518:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11519:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11520:     for (my $i=0; $i<$depth; $i++) {
                   11521:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11522:     }
                   11523:     if ($is_dir) {
                   11524:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11525:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11526:     } else {
                   11527:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11528:     }
                   11529:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11530:                &end_data_table_row();
                   11531:     return $output;
                   11532: }
                   11533: 
                   11534: sub archive_options_form {
1.1065    raeburn  11535:     my ($form,$display,$count,$hiddenelem) = @_;
                   11536:     my %lt = &Apache::lonlocal::texthash(
                   11537:                perm => 'Permanently remove archive file?',
                   11538:                hows => 'How should each extracted item be incorporated in the course?',
                   11539:                cont => 'Content actions for all',
                   11540:                addf => 'Add as folder/file',
                   11541:                incd => 'Include as dependency for a displayed file',
                   11542:                disc => 'Discard',
                   11543:                no   => 'No',
                   11544:                yes  => 'Yes',
                   11545:                save => 'Save',
                   11546:     );
                   11547:     my $output = <<"END";
                   11548: <form name="$form" method="post" action="">
                   11549: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11550: <label>
                   11551:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11552: </label>
                   11553: &nbsp;
                   11554: <label>
                   11555:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11556: </span>
                   11557: </p>
                   11558: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11559: <br />$lt{'hows'}
                   11560: <div class="LC_columnSection">
                   11561:   <fieldset>
                   11562:     <legend>$lt{'cont'}</legend>
                   11563:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11564:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11565:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11566:   </fieldset>
                   11567: </div>
                   11568: END
                   11569:     return $output.
1.1055    raeburn  11570:            &start_data_table()."\n".
1.1065    raeburn  11571:            $display."\n".
1.1055    raeburn  11572:            &end_data_table()."\n".
                   11573:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11574:            $hiddenelem.
1.1065    raeburn  11575:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11576:            '</form>';
                   11577: }
                   11578: 
                   11579: sub archive_javascript {
1.1056    raeburn  11580:     my ($startcount,$numitems,$titles,$children) = @_;
                   11581:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11582:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11583:     my $scripttag = <<START;
                   11584: <script type="text/javascript">
                   11585: // <![CDATA[
                   11586: 
                   11587: function checkAll(form,prefix) {
                   11588:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11589:     for (var i=0; i < form.elements.length; i++) {
                   11590:         var id = form.elements[i].id;
                   11591:         if ((id != '') && (id != undefined)) {
                   11592:             if (idstr.test(id)) {
                   11593:                 if (form.elements[i].type == 'radio') {
                   11594:                     form.elements[i].checked = true;
1.1056    raeburn  11595:                     var nostart = i-$startcount;
1.1059    raeburn  11596:                     var offset = nostart%7;
                   11597:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11598:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11599:                 }
                   11600:             }
                   11601:         }
                   11602:     }
                   11603: }
                   11604: 
                   11605: function propagateCheck(form,count) {
                   11606:     if (count > 0) {
1.1059    raeburn  11607:         var startelement = $startcount + ((count-1) * 7);
                   11608:         for (var j=1; j<6; j++) {
                   11609:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11610:                 var item = startelement + j; 
                   11611:                 if (form.elements[item].type == 'radio') {
                   11612:                     if (form.elements[item].checked) {
                   11613:                         containerCheck(form,count,j);
                   11614:                         break;
                   11615:                     }
1.1055    raeburn  11616:                 }
                   11617:             }
                   11618:         }
                   11619:     }
                   11620: }
                   11621: 
                   11622: numitems = $numitems
1.1056    raeburn  11623: var titles = new Array(numitems);
                   11624: var parents = new Array(numitems);
1.1055    raeburn  11625: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11626:     parents[i] = new Array;
1.1055    raeburn  11627: }
1.1059    raeburn  11628: var maintitle = '$maintitle';
1.1055    raeburn  11629: 
                   11630: START
                   11631: 
1.1056    raeburn  11632:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11633:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11634:         for (my $i=0; $i<@contents; $i ++) {
                   11635:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11636:         }
                   11637:     }
                   11638: 
1.1056    raeburn  11639:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11640:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11641:     }
                   11642: 
1.1055    raeburn  11643:     $scripttag .= <<END;
                   11644: 
                   11645: function containerCheck(form,count,offset) {
                   11646:     if (count > 0) {
1.1056    raeburn  11647:         dependencyCheck(form,count,offset);
1.1059    raeburn  11648:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11649:         form.elements[item].checked = true;
                   11650:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11651:             if (parents[count].length > 0) {
                   11652:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11653:                     containerCheck(form,parents[count][j],offset);
                   11654:                 }
                   11655:             }
                   11656:         }
                   11657:     }
                   11658: }
                   11659: 
                   11660: function dependencyCheck(form,count,offset) {
                   11661:     if (count > 0) {
1.1059    raeburn  11662:         var chosen = (offset+$startcount)+7*(count-1);
                   11663:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11664:         var currtype = form.elements[depitem].type;
                   11665:         if (form.elements[chosen].value == 'dependency') {
                   11666:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11667:             form.elements[depitem].options.length = 0;
                   11668:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085    raeburn  11669:             for (var i=1; i<=numitems; i++) {
                   11670:                 if (i == count) {
                   11671:                     continue;
                   11672:                 }
1.1059    raeburn  11673:                 var startelement = $startcount + (i-1) * 7;
                   11674:                 for (var j=1; j<6; j++) {
                   11675:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11676:                         var item = startelement + j;
                   11677:                         if (form.elements[item].type == 'radio') {
                   11678:                             if (form.elements[item].checked) {
                   11679:                                 if (form.elements[item].value == 'display') {
                   11680:                                     var n = form.elements[depitem].options.length;
                   11681:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11682:                                 }
                   11683:                             }
                   11684:                         }
                   11685:                     }
                   11686:                 }
                   11687:             }
                   11688:         } else {
                   11689:             document.getElementById('arc_depon_'+count).style.display='none';
                   11690:             form.elements[depitem].options.length = 0;
                   11691:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11692:         }
1.1059    raeburn  11693:         titleCheck(form,count,offset);
1.1056    raeburn  11694:     }
                   11695: }
                   11696: 
                   11697: function propagateSelect(form,count,offset) {
                   11698:     if (count > 0) {
1.1065    raeburn  11699:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11700:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11701:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11702:             if (parents[count].length > 0) {
                   11703:                 for (var j=0; j<parents[count].length; j++) {
                   11704:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11705:                 }
                   11706:             }
                   11707:         }
                   11708:     }
                   11709: }
1.1056    raeburn  11710: 
                   11711: function containerSelect(form,count,offset,picked) {
                   11712:     if (count > 0) {
1.1065    raeburn  11713:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11714:         if (form.elements[item].type == 'radio') {
                   11715:             if (form.elements[item].value == 'dependency') {
                   11716:                 if (form.elements[item+1].type == 'select-one') {
                   11717:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11718:                         if (form.elements[item+1].options[i].value == picked) {
                   11719:                             form.elements[item+1].selectedIndex = i;
                   11720:                             break;
                   11721:                         }
                   11722:                     }
                   11723:                 }
                   11724:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11725:                     if (parents[count].length > 0) {
                   11726:                         for (var j=0; j<parents[count].length; j++) {
                   11727:                             containerSelect(form,parents[count][j],offset,picked);
                   11728:                         }
                   11729:                     }
                   11730:                 }
                   11731:             }
                   11732:         }
                   11733:     }
                   11734: }
                   11735: 
1.1059    raeburn  11736: function titleCheck(form,count,offset) {
                   11737:     if (count > 0) {
                   11738:         var chosen = (offset+$startcount)+7*(count-1);
                   11739:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11740:         var currtype = form.elements[depitem].type;
                   11741:         if (form.elements[chosen].value == 'display') {
                   11742:             document.getElementById('arc_title_'+count).style.display='block';
                   11743:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11744:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11745:             }
                   11746:         } else {
                   11747:             document.getElementById('arc_title_'+count).style.display='none';
                   11748:             if (currtype == 'text') { 
                   11749:                 document.getElementById('archive_title_'+count).value='';
                   11750:             }
                   11751:         }
                   11752:     }
                   11753:     return;
                   11754: }
                   11755: 
1.1055    raeburn  11756: // ]]>
                   11757: </script>
                   11758: END
                   11759:     return $scripttag;
                   11760: }
                   11761: 
                   11762: sub process_extracted_files {
1.1067    raeburn  11763:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11764:     my $numitems = $env{'form.archive_count'};
                   11765:     return unless ($numitems);
                   11766:     my @ids=&Apache::lonnet::current_machine_ids();
                   11767:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11768:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11769:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11770:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11771:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11772:         $pathtocheck = "$dir_root/$destination";
                   11773:         $dir = $dir_root;
                   11774:         $ishome = 1;
                   11775:     } else {
                   11776:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11777:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11778:         $dir = "$dir_root/$docudom/$docuname";    
                   11779:     }
                   11780:     my $currdir = "$dir_root/$destination";
                   11781:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11782:     if ($env{'form.folderpath'}) {
                   11783:         my @items = split('&',$env{'form.folderpath'});
                   11784:         $folders{'0'} = $items[-2];
1.1099    raeburn  11785:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11786:             $containers{'0'}='page';
                   11787:         } else {  
                   11788:             $containers{'0'}='sequence';
                   11789:         }
1.1055    raeburn  11790:     }
                   11791:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11792:     if ($numitems) {
                   11793:         for (my $i=1; $i<=$numitems; $i++) {
                   11794:             my $path = $env{'form.archive_content_'.$i};
                   11795:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11796:                 my $item = $1;
                   11797:                 $toplevelitems{$item} = $i;
                   11798:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11799:                     $is_dir{$item} = 1;
                   11800:                 }
                   11801:             }
                   11802:         }
                   11803:     }
1.1067    raeburn  11804:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11805:     if (keys(%toplevelitems) > 0) {
                   11806:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11807:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11808:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11809:     }
1.1066    raeburn  11810:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11811:     if ($numitems) {
                   11812:         for (my $i=1; $i<=$numitems; $i++) {
1.1086    raeburn  11813:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11814:             my $path = $env{'form.archive_content_'.$i};
                   11815:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11816:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11817:                     if ($prefix ne '' && $path ne '') {
                   11818:                         if (-e $prefix.$path) {
1.1066    raeburn  11819:                             if ((@archdirs > 0) && 
                   11820:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11821:                                 $todeletedir{$prefix.$path} = 1;
                   11822:                             } else {
                   11823:                                 $todelete{$prefix.$path} = 1;
                   11824:                             }
1.1055    raeburn  11825:                         }
                   11826:                     }
                   11827:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11828:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11829:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11830:                     $docstitle = $env{'form.archive_title_'.$i};
                   11831:                     if ($docstitle eq '') {
                   11832:                         $docstitle = $title;
                   11833:                     }
1.1055    raeburn  11834:                     $outer = 0;
1.1056    raeburn  11835:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11836:                         if (@{$dirorder{$i}} > 0) {
                   11837:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11838:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11839:                                     $outer = $item;
                   11840:                                     last;
                   11841:                                 }
                   11842:                             }
                   11843:                         }
                   11844:                     }
                   11845:                     my ($errtext,$fatal) = 
                   11846:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11847:                                                '/'.$folders{$outer}.'.'.
                   11848:                                                $containers{$outer});
                   11849:                     next if ($fatal);
                   11850:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11851:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11852:                             $mapinner{$i} = time;
1.1055    raeburn  11853:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11854:                             $containers{$i} = 'sequence';
                   11855:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11856:                                       $folders{$i}.'.'.$containers{$i};
                   11857:                             my $newidx = &LONCAPA::map::getresidx();
                   11858:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11859:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11860:                             push(@LONCAPA::map::order,$newidx);
                   11861:                             my ($outtext,$errtext) =
                   11862:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11863:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  11864:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11865:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11866:                             unless ($errtext) {
                   11867:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11868:                             }
1.1055    raeburn  11869:                         }
                   11870:                     } else {
                   11871:                         if ($context eq 'coursedocs') {
                   11872:                             my $newidx=&LONCAPA::map::getresidx();
                   11873:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11874:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11875:                                       $title;
                   11876:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11877:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11878:                             }
                   11879:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11880:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11881:                             }
                   11882:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11883:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11884:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11885:                                 unless ($ishome) {
                   11886:                                     my $fetch = "$newdest{$i}/$title";
                   11887:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11888:                                     $prompttofetch{$fetch} = 1;
                   11889:                                 }
1.1055    raeburn  11890:                             }
                   11891:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11892:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11893:                             push(@LONCAPA::map::order, $newidx);
                   11894:                             my ($outtext,$errtext)=
                   11895:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11896:                                                         $docuname.'/'.$folders{$outer}.
1.1087    raeburn  11897:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11898:                             unless ($errtext) {
                   11899:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11900:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11901:                                 }
                   11902:                             }
1.1055    raeburn  11903:                         }
                   11904:                     }
1.1086    raeburn  11905:                 }
                   11906:             } else {
                   11907:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   11908:             }
                   11909:         }
                   11910:         for (my $i=1; $i<=$numitems; $i++) {
                   11911:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11912:             my $path = $env{'form.archive_content_'.$i};
                   11913:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11914:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11915:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11916:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11917:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11918:                         my ($itemidx,$fullpath,$relpath);
                   11919:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11920:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11921:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086    raeburn  11922:                                 if ($dirorder{$i}->[$j] eq $container) {
                   11923:                                     $itemidx = $j;
1.1056    raeburn  11924:                                 }
                   11925:                             }
1.1086    raeburn  11926:                         }
                   11927:                         if ($itemidx eq '') {
                   11928:                             $itemidx =  0;
                   11929:                         } 
                   11930:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   11931:                             if ($mapinner{$referrer{$i}}) {
                   11932:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   11933:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11934:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11935:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11936:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11937:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11938:                                             if (!-e $fullpath) {
                   11939:                                                 mkdir($fullpath,0755);
1.1056    raeburn  11940:                                             }
                   11941:                                         }
1.1086    raeburn  11942:                                     } else {
                   11943:                                         last;
1.1056    raeburn  11944:                                     }
1.1086    raeburn  11945:                                 }
                   11946:                             }
                   11947:                         } elsif ($newdest{$referrer{$i}}) {
                   11948:                             $fullpath = $newdest{$referrer{$i}};
                   11949:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   11950:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   11951:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   11952:                                     last;
                   11953:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   11954:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   11955:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11956:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   11957:                                         if (!-e $fullpath) {
                   11958:                                             mkdir($fullpath,0755);
1.1056    raeburn  11959:                                         }
                   11960:                                     }
1.1086    raeburn  11961:                                 } else {
                   11962:                                     last;
1.1056    raeburn  11963:                                 }
1.1055    raeburn  11964:                             }
                   11965:                         }
1.1086    raeburn  11966:                         if ($fullpath ne '') {
                   11967:                             if (-e "$prefix$path") {
                   11968:                                 system("mv $prefix$path $fullpath/$title");
                   11969:                             }
                   11970:                             if (-e "$fullpath/$title") {
                   11971:                                 my $showpath;
                   11972:                                 if ($relpath ne '') {
                   11973:                                     $showpath = "$relpath/$title";
                   11974:                                 } else {
                   11975:                                     $showpath = "/$title";
                   11976:                                 } 
                   11977:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   11978:                             } 
                   11979:                             unless ($ishome) {
                   11980:                                 my $fetch = "$fullpath/$title";
                   11981:                                 $fetch =~ s/^\Q$prefix$dir\E//; 
                   11982:                                 $prompttofetch{$fetch} = 1;
                   11983:                             }
                   11984:                         }
1.1055    raeburn  11985:                     }
1.1086    raeburn  11986:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   11987:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   11988:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  11989:                 }
                   11990:             } else {
                   11991:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; 
                   11992:             }
                   11993:         }
                   11994:         if (keys(%todelete)) {
                   11995:             foreach my $key (keys(%todelete)) {
                   11996:                 unlink($key);
1.1066    raeburn  11997:             }
                   11998:         }
                   11999:         if (keys(%todeletedir)) {
                   12000:             foreach my $key (keys(%todeletedir)) {
                   12001:                 rmdir($key);
                   12002:             }
                   12003:         }
                   12004:         foreach my $dir (sort(keys(%is_dir))) {
                   12005:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12006:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12007:             }
                   12008:         }
1.1067    raeburn  12009:         if ($result ne '') {
                   12010:             $output .= '<ul>'."\n".
                   12011:                        $result."\n".
                   12012:                        '</ul>';
                   12013:         }
                   12014:         unless ($ishome) {
                   12015:             my $replicationfail;
                   12016:             foreach my $item (keys(%prompttofetch)) {
                   12017:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12018:                 unless ($fetchresult eq 'ok') {
                   12019:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12020:                 }
                   12021:             }
                   12022:             if ($replicationfail) {
                   12023:                 $output .= '<p class="LC_error">'.
                   12024:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12025:                            $replicationfail.
                   12026:                            '</ul></p>';
                   12027:             }
                   12028:         }
1.1055    raeburn  12029:     } else {
                   12030:         $warning = &mt('No items found in archive.');
                   12031:     }
                   12032:     if ($error) {
                   12033:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12034:                    $error.'</p>'."\n";
                   12035:     }
                   12036:     if ($warning) {
                   12037:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12038:     }
                   12039:     return $output;
                   12040: }
                   12041: 
1.1066    raeburn  12042: sub cleanup_empty_dirs {
                   12043:     my ($path) = @_;
                   12044:     if (($path ne '') && (-d $path)) {
                   12045:         if (opendir(my $dirh,$path)) {
                   12046:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12047:             my $numitems = 0;
                   12048:             foreach my $item (@dircontents) {
                   12049:                 if (-d "$path/$item") {
1.1111    raeburn  12050:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12051:                     if (-e "$path/$item") {
                   12052:                         $numitems ++;
                   12053:                     }
                   12054:                 } else {
                   12055:                     $numitems ++;
                   12056:                 }
                   12057:             }
                   12058:             if ($numitems == 0) {
                   12059:                 rmdir($path);
                   12060:             }
                   12061:             closedir($dirh);
                   12062:         }
                   12063:     }
                   12064:     return;
                   12065: }
                   12066: 
1.41      ng       12067: =pod
1.45      matthew  12068: 
1.1068    raeburn  12069: =item &get_folder_hierarchy()
                   12070: 
                   12071: Provides hierarchy of names of folders/sub-folders containing the current
                   12072: item,
                   12073: 
                   12074: Inputs: 3
                   12075:      - $navmap - navmaps object
                   12076: 
                   12077:      - $map - url for map (either the trigger itself, or map containing
                   12078:                            the resource, which is the trigger).
                   12079: 
                   12080:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12081: 
                   12082: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12083: 
                   12084: =cut
                   12085: 
                   12086: sub get_folder_hierarchy {
                   12087:     my ($navmap,$map,$showitem) = @_;
                   12088:     my @pathitems;
                   12089:     if (ref($navmap)) {
                   12090:         my $mapres = $navmap->getResourceByUrl($map);
                   12091:         if (ref($mapres)) {
                   12092:             my $pcslist = $mapres->map_hierarchy();
                   12093:             if ($pcslist ne '') {
                   12094:                 my @pcs = split(/,/,$pcslist);
                   12095:                 foreach my $pc (@pcs) {
                   12096:                     if ($pc == 1) {
1.1129    raeburn  12097:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12098:                     } else {
                   12099:                         my $res = $navmap->getByMapPc($pc);
                   12100:                         if (ref($res)) {
                   12101:                             my $title = $res->compTitle();
                   12102:                             $title =~ s/\W+/_/g;
                   12103:                             if ($title ne '') {
                   12104:                                 push(@pathitems,$title);
                   12105:                             }
                   12106:                         }
                   12107:                     }
                   12108:                 }
                   12109:             }
1.1071    raeburn  12110:             if ($showitem) {
                   12111:                 if ($mapres->{ID} eq '0.0') {
1.1129    raeburn  12112:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12113:                 } else {
                   12114:                     my $maptitle = $mapres->compTitle();
                   12115:                     $maptitle =~ s/\W+/_/g;
                   12116:                     if ($maptitle ne '') {
                   12117:                         push(@pathitems,$maptitle);
                   12118:                     }
1.1068    raeburn  12119:                 }
                   12120:             }
                   12121:         }
                   12122:     }
                   12123:     return @pathitems;
                   12124: }
                   12125: 
                   12126: =pod
                   12127: 
1.1015    raeburn  12128: =item * &get_turnedin_filepath()
                   12129: 
                   12130: Determines path in a user's portfolio file for storage of files uploaded
                   12131: to a specific essayresponse or dropbox item.
                   12132: 
                   12133: Inputs: 3 required + 1 optional.
                   12134: $symb is symb for resource, $uname and $udom are for current user (required).
                   12135: $caller is optional (can be "submission", if routine is called when storing
                   12136: an upoaded file when "Submit Answer" button was pressed).
                   12137: 
                   12138: Returns array containing $path and $multiresp. 
                   12139: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12140: than one file upload item.  Callers of routine should append partid as a 
                   12141: subdirectory to $path in cases where $multiresp is 1.
                   12142: 
                   12143: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12144: 
                   12145: =cut
                   12146: 
                   12147: sub get_turnedin_filepath {
                   12148:     my ($symb,$uname,$udom,$caller) = @_;
                   12149:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12150:     my $turnindir;
                   12151:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12152:     $turnindir = $userhash{'turnindir'};
                   12153:     my ($path,$multiresp);
                   12154:     if ($turnindir eq '') {
                   12155:         if ($caller eq 'submission') {
                   12156:             $turnindir = &mt('turned in');
                   12157:             $turnindir =~ s/\W+/_/g;
                   12158:             my %newhash = (
                   12159:                             'turnindir' => $turnindir,
                   12160:                           );
                   12161:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12162:         }
                   12163:     }
                   12164:     if ($turnindir ne '') {
                   12165:         $path = '/'.$turnindir.'/';
                   12166:         my ($multipart,$turnin,@pathitems);
                   12167:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12168:         if (defined($navmap)) {
                   12169:             my $mapres = $navmap->getResourceByUrl($map);
                   12170:             if (ref($mapres)) {
                   12171:                 my $pcslist = $mapres->map_hierarchy();
                   12172:                 if ($pcslist ne '') {
                   12173:                     foreach my $pc (split(/,/,$pcslist)) {
                   12174:                         my $res = $navmap->getByMapPc($pc);
                   12175:                         if (ref($res)) {
                   12176:                             my $title = $res->compTitle();
                   12177:                             $title =~ s/\W+/_/g;
                   12178:                             if ($title ne '') {
1.1149    raeburn  12179:                                 if (($pc > 1) && (length($title) > 12)) {
                   12180:                                     $title = substr($title,0,12);
                   12181:                                 }
1.1015    raeburn  12182:                                 push(@pathitems,$title);
                   12183:                             }
                   12184:                         }
                   12185:                     }
                   12186:                 }
                   12187:                 my $maptitle = $mapres->compTitle();
                   12188:                 $maptitle =~ s/\W+/_/g;
                   12189:                 if ($maptitle ne '') {
1.1149    raeburn  12190:                     if (length($maptitle) > 12) {
                   12191:                         $maptitle = substr($maptitle,0,12);
                   12192:                     }
1.1015    raeburn  12193:                     push(@pathitems,$maptitle);
                   12194:                 }
                   12195:                 unless ($env{'request.state'} eq 'construct') {
                   12196:                     my $res = $navmap->getBySymb($symb);
                   12197:                     if (ref($res)) {
                   12198:                         my $partlist = $res->parts();
                   12199:                         my $totaluploads = 0;
                   12200:                         if (ref($partlist) eq 'ARRAY') {
                   12201:                             foreach my $part (@{$partlist}) {
                   12202:                                 my @types = $res->responseType($part);
                   12203:                                 my @ids = $res->responseIds($part);
                   12204:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12205:                                     if ($types[$i] eq 'essay') {
                   12206:                                         my $partid = $part.'_'.$ids[$i];
                   12207:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12208:                                             $totaluploads ++;
                   12209:                                         }
                   12210:                                     }
                   12211:                                 }
                   12212:                             }
                   12213:                             if ($totaluploads > 1) {
                   12214:                                 $multiresp = 1;
                   12215:                             }
                   12216:                         }
                   12217:                     }
                   12218:                 }
                   12219:             } else {
                   12220:                 return;
                   12221:             }
                   12222:         } else {
                   12223:             return;
                   12224:         }
                   12225:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12226:         $restitle =~ s/\W+/_/g;
                   12227:         if ($restitle eq '') {
                   12228:             $restitle = ($resurl =~ m{/[^/]+$});
                   12229:             if ($restitle eq '') {
                   12230:                 $restitle = time;
                   12231:             }
                   12232:         }
1.1149    raeburn  12233:         if (length($restitle) > 12) {
                   12234:             $restitle = substr($restitle,0,12);
                   12235:         }
1.1015    raeburn  12236:         push(@pathitems,$restitle);
                   12237:         $path .= join('/',@pathitems);
                   12238:     }
                   12239:     return ($path,$multiresp);
                   12240: }
                   12241: 
                   12242: =pod
                   12243: 
1.464     albertel 12244: =back
1.41      ng       12245: 
1.112     bowersj2 12246: =head1 CSV Upload/Handling functions
1.38      albertel 12247: 
1.41      ng       12248: =over 4
                   12249: 
1.648     raeburn  12250: =item * &upfile_store($r)
1.41      ng       12251: 
                   12252: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12253: needs $env{'form.upfile'}
1.41      ng       12254: returns $datatoken to be put into hidden field
                   12255: 
                   12256: =cut
1.31      albertel 12257: 
                   12258: sub upfile_store {
                   12259:     my $r=shift;
1.258     albertel 12260:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12261:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12262:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12263:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12264: 
1.258     albertel 12265:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12266: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12267:     {
1.158     raeburn  12268:         my $datafile = $r->dir_config('lonDaemons').
                   12269:                            '/tmp/'.$datatoken.'.tmp';
                   12270:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12271:             print $fh $env{'form.upfile'};
1.158     raeburn  12272:             close($fh);
                   12273:         }
1.31      albertel 12274:     }
                   12275:     return $datatoken;
                   12276: }
                   12277: 
1.56      matthew  12278: =pod
                   12279: 
1.648     raeburn  12280: =item * &load_tmp_file($r)
1.41      ng       12281: 
                   12282: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12283: needs $env{'form.datatoken'},
                   12284: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12285: 
                   12286: =cut
1.31      albertel 12287: 
                   12288: sub load_tmp_file {
                   12289:     my $r=shift;
                   12290:     my @studentdata=();
                   12291:     {
1.158     raeburn  12292:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12293:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12294:         if ( open(my $fh,"<$studentfile") ) {
                   12295:             @studentdata=<$fh>;
                   12296:             close($fh);
                   12297:         }
1.31      albertel 12298:     }
1.258     albertel 12299:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12300: }
                   12301: 
1.56      matthew  12302: =pod
                   12303: 
1.648     raeburn  12304: =item * &upfile_record_sep()
1.41      ng       12305: 
                   12306: Separate uploaded file into records
                   12307: returns array of records,
1.258     albertel 12308: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12309: 
                   12310: =cut
1.31      albertel 12311: 
                   12312: sub upfile_record_sep {
1.258     albertel 12313:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12314:     } else {
1.248     albertel 12315: 	my @records;
1.258     albertel 12316: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12317: 	    if ($line=~/^\s*$/) { next; }
                   12318: 	    push(@records,$line);
                   12319: 	}
                   12320: 	return @records;
1.31      albertel 12321:     }
                   12322: }
                   12323: 
1.56      matthew  12324: =pod
                   12325: 
1.648     raeburn  12326: =item * &record_sep($record)
1.41      ng       12327: 
1.258     albertel 12328: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12329: 
                   12330: =cut
                   12331: 
1.263     www      12332: sub takeleft {
                   12333:     my $index=shift;
                   12334:     return substr('0000'.$index,-4,4);
                   12335: }
                   12336: 
1.31      albertel 12337: sub record_sep {
                   12338:     my $record=shift;
                   12339:     my %components=();
1.258     albertel 12340:     if ($env{'form.upfiletype'} eq 'xml') {
                   12341:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12342:         my $i=0;
1.356     albertel 12343:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12344:             $field=~s/^(\"|\')//;
                   12345:             $field=~s/(\"|\')$//;
1.263     www      12346:             $components{&takeleft($i)}=$field;
1.31      albertel 12347:             $i++;
                   12348:         }
1.258     albertel 12349:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12350:         my $i=0;
1.356     albertel 12351:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12352:             $field=~s/^(\"|\')//;
                   12353:             $field=~s/(\"|\')$//;
1.263     www      12354:             $components{&takeleft($i)}=$field;
1.31      albertel 12355:             $i++;
                   12356:         }
                   12357:     } else {
1.561     www      12358:         my $separator=',';
1.480     banghart 12359:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12360:             $separator=';';
1.480     banghart 12361:         }
1.31      albertel 12362:         my $i=0;
1.561     www      12363: # the character we are looking for to indicate the end of a quote or a record 
                   12364:         my $looking_for=$separator;
                   12365: # do not add the characters to the fields
                   12366:         my $ignore=0;
                   12367: # we just encountered a separator (or the beginning of the record)
                   12368:         my $just_found_separator=1;
                   12369: # store the field we are working on here
                   12370:         my $field='';
                   12371: # work our way through all characters in record
                   12372:         foreach my $character ($record=~/(.)/g) {
                   12373:             if ($character eq $looking_for) {
                   12374:                if ($character ne $separator) {
                   12375: # Found the end of a quote, again looking for separator
                   12376:                   $looking_for=$separator;
                   12377:                   $ignore=1;
                   12378:                } else {
                   12379: # Found a separator, store away what we got
                   12380:                   $components{&takeleft($i)}=$field;
                   12381: 	          $i++;
                   12382:                   $just_found_separator=1;
                   12383:                   $ignore=0;
                   12384:                   $field='';
                   12385:                }
                   12386:                next;
                   12387:             }
                   12388: # single or double quotation marks after a separator indicate beginning of a quote
                   12389: # we are now looking for the end of the quote and need to ignore separators
                   12390:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12391:                $looking_for=$character;
                   12392:                next;
                   12393:             }
                   12394: # ignore would be true after we reached the end of a quote
                   12395:             if ($ignore) { next; }
                   12396:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   12397:             $field.=$character;
                   12398:             $just_found_separator=0; 
1.31      albertel 12399:         }
1.561     www      12400: # catch the very last entry, since we never encountered the separator
                   12401:         $components{&takeleft($i)}=$field;
1.31      albertel 12402:     }
                   12403:     return %components;
                   12404: }
                   12405: 
1.144     matthew  12406: ######################################################
                   12407: ######################################################
                   12408: 
1.56      matthew  12409: =pod
                   12410: 
1.648     raeburn  12411: =item * &upfile_select_html()
1.41      ng       12412: 
1.144     matthew  12413: Return HTML code to select a file from the users machine and specify 
                   12414: the file type.
1.41      ng       12415: 
                   12416: =cut
                   12417: 
1.144     matthew  12418: ######################################################
                   12419: ######################################################
1.31      albertel 12420: sub upfile_select_html {
1.144     matthew  12421:     my %Types = (
                   12422:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 12423:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  12424:                  space => &mt('Space separated'),
                   12425:                  tab   => &mt('Tabulator separated'),
                   12426: #                 xml   => &mt('HTML/XML'),
                   12427:                  );
                   12428:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  12429:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  12430:     foreach my $type (sort(keys(%Types))) {
                   12431:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   12432:     }
                   12433:     $Str .= "</select>\n";
                   12434:     return $Str;
1.31      albertel 12435: }
                   12436: 
1.301     albertel 12437: sub get_samples {
                   12438:     my ($records,$toget) = @_;
                   12439:     my @samples=({});
                   12440:     my $got=0;
                   12441:     foreach my $rec (@$records) {
                   12442: 	my %temp = &record_sep($rec);
                   12443: 	if (! grep(/\S/, values(%temp))) { next; }
                   12444: 	if (%temp) {
                   12445: 	    $samples[$got]=\%temp;
                   12446: 	    $got++;
                   12447: 	    if ($got == $toget) { last; }
                   12448: 	}
                   12449:     }
                   12450:     return \@samples;
                   12451: }
                   12452: 
1.144     matthew  12453: ######################################################
                   12454: ######################################################
                   12455: 
1.56      matthew  12456: =pod
                   12457: 
1.648     raeburn  12458: =item * &csv_print_samples($r,$records)
1.41      ng       12459: 
                   12460: Prints a table of sample values from each column uploaded $r is an
                   12461: Apache Request ref, $records is an arrayref from
                   12462: &Apache::loncommon::upfile_record_sep
                   12463: 
                   12464: =cut
                   12465: 
1.144     matthew  12466: ######################################################
                   12467: ######################################################
1.31      albertel 12468: sub csv_print_samples {
                   12469:     my ($r,$records) = @_;
1.662     bisitz   12470:     my $samples = &get_samples($records,5);
1.301     albertel 12471: 
1.594     raeburn  12472:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12473:               &start_data_table_header_row());
1.356     albertel 12474:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12475:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12476:     $r->print(&end_data_table_header_row());
1.301     albertel 12477:     foreach my $hash (@$samples) {
1.594     raeburn  12478: 	$r->print(&start_data_table_row());
1.356     albertel 12479: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12480: 	    $r->print('<td>');
1.356     albertel 12481: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12482: 	    $r->print('</td>');
                   12483: 	}
1.594     raeburn  12484: 	$r->print(&end_data_table_row());
1.31      albertel 12485:     }
1.594     raeburn  12486:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12487: }
                   12488: 
1.144     matthew  12489: ######################################################
                   12490: ######################################################
                   12491: 
1.56      matthew  12492: =pod
                   12493: 
1.648     raeburn  12494: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12495: 
                   12496: Prints a table to create associations between values and table columns.
1.144     matthew  12497: 
1.41      ng       12498: $r is an Apache Request ref,
                   12499: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12500: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12501: 
                   12502: =cut
                   12503: 
1.144     matthew  12504: ######################################################
                   12505: ######################################################
1.31      albertel 12506: sub csv_print_select_table {
                   12507:     my ($r,$records,$d) = @_;
1.301     albertel 12508:     my $i=0;
                   12509:     my $samples = &get_samples($records,1);
1.144     matthew  12510:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12511: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12512:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12513:               '<th>'.&mt('Column').'</th>'.
                   12514:               &end_data_table_header_row()."\n");
1.356     albertel 12515:     foreach my $array_ref (@$d) {
                   12516: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12517: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12518: 
1.875     bisitz   12519: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12520: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12521: 	$r->print('<option value="none"></option>');
1.356     albertel 12522: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12523: 	    $r->print('<option value="'.$sample.'"'.
                   12524:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12525:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12526: 	}
1.594     raeburn  12527: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12528: 	$i++;
                   12529:     }
1.594     raeburn  12530:     $r->print(&end_data_table());
1.31      albertel 12531:     $i--;
                   12532:     return $i;
                   12533: }
1.56      matthew  12534: 
1.144     matthew  12535: ######################################################
                   12536: ######################################################
                   12537: 
1.56      matthew  12538: =pod
1.31      albertel 12539: 
1.648     raeburn  12540: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12541: 
                   12542: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12543: 
                   12544: $r is an Apache Request ref,
                   12545: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12546: $d is an array of 2 element arrays (internal name, displayed name)
                   12547: 
                   12548: =cut
                   12549: 
1.144     matthew  12550: ######################################################
                   12551: ######################################################
1.31      albertel 12552: sub csv_samples_select_table {
                   12553:     my ($r,$records,$d) = @_;
                   12554:     my $i=0;
1.144     matthew  12555:     #
1.662     bisitz   12556:     my $max_samples = 5;
                   12557:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12558:     $r->print(&start_data_table().
                   12559:               &start_data_table_header_row().'<th>'.
                   12560:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12561:               &end_data_table_header_row());
1.301     albertel 12562: 
                   12563:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12564: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12565: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12566: 	foreach my $option (@$d) {
                   12567: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12568: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12569:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12570:                       $display.'</option>');
1.31      albertel 12571: 	}
                   12572: 	$r->print('</select></td><td>');
1.662     bisitz   12573: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12574: 	    if (defined($samples->[$line]{$key})) { 
                   12575: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12576: 	    }
                   12577: 	}
1.594     raeburn  12578: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12579: 	$i++;
                   12580:     }
1.594     raeburn  12581:     $r->print(&end_data_table());
1.31      albertel 12582:     $i--;
                   12583:     return($i);
1.115     matthew  12584: }
                   12585: 
1.144     matthew  12586: ######################################################
                   12587: ######################################################
                   12588: 
1.115     matthew  12589: =pod
                   12590: 
1.648     raeburn  12591: =item * &clean_excel_name($name)
1.115     matthew  12592: 
                   12593: Returns a replacement for $name which does not contain any illegal characters.
                   12594: 
                   12595: =cut
                   12596: 
1.144     matthew  12597: ######################################################
                   12598: ######################################################
1.115     matthew  12599: sub clean_excel_name {
                   12600:     my ($name) = @_;
                   12601:     $name =~ s/[:\*\?\/\\]//g;
                   12602:     if (length($name) > 31) {
                   12603:         $name = substr($name,0,31);
                   12604:     }
                   12605:     return $name;
1.25      albertel 12606: }
1.84      albertel 12607: 
1.85      albertel 12608: =pod
                   12609: 
1.648     raeburn  12610: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12611: 
                   12612: Returns either 1 or undef
                   12613: 
                   12614: 1 if the part is to be hidden, undef if it is to be shown
                   12615: 
                   12616: Arguments are:
                   12617: 
                   12618: $id the id of the part to be checked
                   12619: $symb, optional the symb of the resource to check
                   12620: $udom, optional the domain of the user to check for
                   12621: $uname, optional the username of the user to check for
                   12622: 
                   12623: =cut
1.84      albertel 12624: 
                   12625: sub check_if_partid_hidden {
                   12626:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12627:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12628: 					 $symb,$udom,$uname);
1.141     albertel 12629:     my $truth=1;
                   12630:     #if the string starts with !, then the list is the list to show not hide
                   12631:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12632:     my @hiddenlist=split(/,/,$hiddenparts);
                   12633:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12634: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12635:     }
1.141     albertel 12636:     return !$truth;
1.84      albertel 12637: }
1.127     matthew  12638: 
1.138     matthew  12639: 
                   12640: ############################################################
                   12641: ############################################################
                   12642: 
                   12643: =pod
                   12644: 
1.157     matthew  12645: =back 
                   12646: 
1.138     matthew  12647: =head1 cgi-bin script and graphing routines
                   12648: 
1.157     matthew  12649: =over 4
                   12650: 
1.648     raeburn  12651: =item * &get_cgi_id()
1.138     matthew  12652: 
                   12653: Inputs: none
                   12654: 
                   12655: Returns an id which can be used to pass environment variables
                   12656: to various cgi-bin scripts.  These environment variables will
                   12657: be removed from the users environment after a given time by
                   12658: the routine &Apache::lonnet::transfer_profile_to_env.
                   12659: 
                   12660: =cut
                   12661: 
                   12662: ############################################################
                   12663: ############################################################
1.152     albertel 12664: my $uniq=0;
1.136     matthew  12665: sub get_cgi_id {
1.154     albertel 12666:     $uniq=($uniq+1)%100000;
1.280     albertel 12667:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12668: }
                   12669: 
1.127     matthew  12670: ############################################################
                   12671: ############################################################
                   12672: 
                   12673: =pod
                   12674: 
1.648     raeburn  12675: =item * &DrawBarGraph()
1.127     matthew  12676: 
1.138     matthew  12677: Facilitates the plotting of data in a (stacked) bar graph.
                   12678: Puts plot definition data into the users environment in order for 
                   12679: graph.png to plot it.  Returns an <img> tag for the plot.
                   12680: The bars on the plot are labeled '1','2',...,'n'.
                   12681: 
                   12682: Inputs:
                   12683: 
                   12684: =over 4
                   12685: 
                   12686: =item $Title: string, the title of the plot
                   12687: 
                   12688: =item $xlabel: string, text describing the X-axis of the plot
                   12689: 
                   12690: =item $ylabel: string, text describing the Y-axis of the plot
                   12691: 
                   12692: =item $Max: scalar, the maximum Y value to use in the plot
                   12693: If $Max is < any data point, the graph will not be rendered.
                   12694: 
1.140     matthew  12695: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12696: they are plotted.  If undefined, default values will be used.
                   12697: 
1.178     matthew  12698: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12699: 
1.138     matthew  12700: =item @Values: An array of array references.  Each array reference holds data
                   12701: to be plotted in a stacked bar chart.
                   12702: 
1.239     matthew  12703: =item If the final element of @Values is a hash reference the key/value
                   12704: pairs will be added to the graph definition.
                   12705: 
1.138     matthew  12706: =back
                   12707: 
                   12708: Returns:
                   12709: 
                   12710: An <img> tag which references graph.png and the appropriate identifying
                   12711: information for the plot.
                   12712: 
1.127     matthew  12713: =cut
                   12714: 
                   12715: ############################################################
                   12716: ############################################################
1.134     matthew  12717: sub DrawBarGraph {
1.178     matthew  12718:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12719:     #
                   12720:     if (! defined($colors)) {
                   12721:         $colors = ['#33ff00', 
                   12722:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12723:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12724:                   ]; 
                   12725:     }
1.228     matthew  12726:     my $extra_settings = {};
                   12727:     if (ref($Values[-1]) eq 'HASH') {
                   12728:         $extra_settings = pop(@Values);
                   12729:     }
1.127     matthew  12730:     #
1.136     matthew  12731:     my $identifier = &get_cgi_id();
                   12732:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12733:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12734:         return '';
                   12735:     }
1.225     matthew  12736:     #
                   12737:     my @Labels;
                   12738:     if (defined($labels)) {
                   12739:         @Labels = @$labels;
                   12740:     } else {
                   12741:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12742:             push (@Labels,$i+1);
                   12743:         }
                   12744:     }
                   12745:     #
1.129     matthew  12746:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12747:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12748:     my %ValuesHash;
                   12749:     my $NumSets=1;
                   12750:     foreach my $array (@Values) {
                   12751:         next if (! ref($array));
1.136     matthew  12752:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12753:             join(',',@$array);
1.129     matthew  12754:     }
1.127     matthew  12755:     #
1.136     matthew  12756:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12757:     if ($NumBars < 3) {
                   12758:         $width = 120+$NumBars*32;
1.220     matthew  12759:         $xskip = 1;
1.225     matthew  12760:         $bar_width = 30;
                   12761:     } elsif ($NumBars < 5) {
                   12762:         $width = 120+$NumBars*20;
                   12763:         $xskip = 1;
                   12764:         $bar_width = 20;
1.220     matthew  12765:     } elsif ($NumBars < 10) {
1.136     matthew  12766:         $width = 120+$NumBars*15;
                   12767:         $xskip = 1;
                   12768:         $bar_width = 15;
                   12769:     } elsif ($NumBars <= 25) {
                   12770:         $width = 120+$NumBars*11;
                   12771:         $xskip = 5;
                   12772:         $bar_width = 8;
                   12773:     } elsif ($NumBars <= 50) {
                   12774:         $width = 120+$NumBars*8;
                   12775:         $xskip = 5;
                   12776:         $bar_width = 4;
                   12777:     } else {
                   12778:         $width = 120+$NumBars*8;
                   12779:         $xskip = 5;
                   12780:         $bar_width = 4;
                   12781:     }
                   12782:     #
1.137     matthew  12783:     $Max = 1 if ($Max < 1);
                   12784:     if ( int($Max) < $Max ) {
                   12785:         $Max++;
                   12786:         $Max = int($Max);
                   12787:     }
1.127     matthew  12788:     $Title  = '' if (! defined($Title));
                   12789:     $xlabel = '' if (! defined($xlabel));
                   12790:     $ylabel = '' if (! defined($ylabel));
1.369     www      12791:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12792:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12793:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12794:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12795:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12796:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12797:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12798:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12799:     $ValuesHash{$id.'.height'}   = $height;
                   12800:     $ValuesHash{$id.'.width'}    = $width;
                   12801:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12802:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12803:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12804:     #
1.228     matthew  12805:     # Deal with other parameters
                   12806:     while (my ($key,$value) = each(%$extra_settings)) {
                   12807:         $ValuesHash{$id.'.'.$key} = $value;
                   12808:     }
                   12809:     #
1.646     raeburn  12810:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12811:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12812: }
                   12813: 
                   12814: ############################################################
                   12815: ############################################################
                   12816: 
                   12817: =pod
                   12818: 
1.648     raeburn  12819: =item * &DrawXYGraph()
1.137     matthew  12820: 
1.138     matthew  12821: Facilitates the plotting of data in an XY graph.
                   12822: Puts plot definition data into the users environment in order for 
                   12823: graph.png to plot it.  Returns an <img> tag for the plot.
                   12824: 
                   12825: Inputs:
                   12826: 
                   12827: =over 4
                   12828: 
                   12829: =item $Title: string, the title of the plot
                   12830: 
                   12831: =item $xlabel: string, text describing the X-axis of the plot
                   12832: 
                   12833: =item $ylabel: string, text describing the Y-axis of the plot
                   12834: 
                   12835: =item $Max: scalar, the maximum Y value to use in the plot
                   12836: If $Max is < any data point, the graph will not be rendered.
                   12837: 
                   12838: =item $colors: Array ref containing the hex color codes for the data to be 
                   12839: plotted in.  If undefined, default values will be used.
                   12840: 
                   12841: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12842: 
                   12843: =item $Ydata: Array ref containing Array refs.  
1.185     www      12844: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12845: 
                   12846: =item %Values: hash indicating or overriding any default values which are 
                   12847: passed to graph.png.  
                   12848: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12849: 
                   12850: =back
                   12851: 
                   12852: Returns:
                   12853: 
                   12854: An <img> tag which references graph.png and the appropriate identifying
                   12855: information for the plot.
                   12856: 
1.137     matthew  12857: =cut
                   12858: 
                   12859: ############################################################
                   12860: ############################################################
                   12861: sub DrawXYGraph {
                   12862:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12863:     #
                   12864:     # Create the identifier for the graph
                   12865:     my $identifier = &get_cgi_id();
                   12866:     my $id = 'cgi.'.$identifier;
                   12867:     #
                   12868:     $Title  = '' if (! defined($Title));
                   12869:     $xlabel = '' if (! defined($xlabel));
                   12870:     $ylabel = '' if (! defined($ylabel));
                   12871:     my %ValuesHash = 
                   12872:         (
1.369     www      12873:          $id.'.title'  => &escape($Title),
                   12874:          $id.'.xlabel' => &escape($xlabel),
                   12875:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12876:          $id.'.y_max_value'=> $Max,
                   12877:          $id.'.labels'     => join(',',@$Xlabels),
                   12878:          $id.'.PlotType'   => 'XY',
                   12879:          );
                   12880:     #
                   12881:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12882:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12883:     }
                   12884:     #
                   12885:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12886:         return '';
                   12887:     }
                   12888:     my $NumSets=1;
1.138     matthew  12889:     foreach my $array (@{$Ydata}){
1.137     matthew  12890:         next if (! ref($array));
                   12891:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12892:     }
1.138     matthew  12893:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12894:     #
                   12895:     # Deal with other parameters
                   12896:     while (my ($key,$value) = each(%Values)) {
                   12897:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12898:     }
                   12899:     #
1.646     raeburn  12900:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12901:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12902: }
                   12903: 
                   12904: ############################################################
                   12905: ############################################################
                   12906: 
                   12907: =pod
                   12908: 
1.648     raeburn  12909: =item * &DrawXYYGraph()
1.138     matthew  12910: 
                   12911: Facilitates the plotting of data in an XY graph with two Y axes.
                   12912: Puts plot definition data into the users environment in order for 
                   12913: graph.png to plot it.  Returns an <img> tag for the plot.
                   12914: 
                   12915: Inputs:
                   12916: 
                   12917: =over 4
                   12918: 
                   12919: =item $Title: string, the title of the plot
                   12920: 
                   12921: =item $xlabel: string, text describing the X-axis of the plot
                   12922: 
                   12923: =item $ylabel: string, text describing the Y-axis of the plot
                   12924: 
                   12925: =item $colors: Array ref containing the hex color codes for the data to be 
                   12926: plotted in.  If undefined, default values will be used.
                   12927: 
                   12928: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12929: 
                   12930: =item $Ydata1: The first data set
                   12931: 
                   12932: =item $Min1: The minimum value of the left Y-axis
                   12933: 
                   12934: =item $Max1: The maximum value of the left Y-axis
                   12935: 
                   12936: =item $Ydata2: The second data set
                   12937: 
                   12938: =item $Min2: The minimum value of the right Y-axis
                   12939: 
                   12940: =item $Max2: The maximum value of the left Y-axis
                   12941: 
                   12942: =item %Values: hash indicating or overriding any default values which are 
                   12943: passed to graph.png.  
                   12944: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12945: 
                   12946: =back
                   12947: 
                   12948: Returns:
                   12949: 
                   12950: An <img> tag which references graph.png and the appropriate identifying
                   12951: information for the plot.
1.136     matthew  12952: 
                   12953: =cut
                   12954: 
                   12955: ############################################################
                   12956: ############################################################
1.137     matthew  12957: sub DrawXYYGraph {
                   12958:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   12959:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  12960:     #
                   12961:     # Create the identifier for the graph
                   12962:     my $identifier = &get_cgi_id();
                   12963:     my $id = 'cgi.'.$identifier;
                   12964:     #
                   12965:     $Title  = '' if (! defined($Title));
                   12966:     $xlabel = '' if (! defined($xlabel));
                   12967:     $ylabel = '' if (! defined($ylabel));
                   12968:     my %ValuesHash = 
                   12969:         (
1.369     www      12970:          $id.'.title'  => &escape($Title),
                   12971:          $id.'.xlabel' => &escape($xlabel),
                   12972:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  12973:          $id.'.labels' => join(',',@$Xlabels),
                   12974:          $id.'.PlotType' => 'XY',
                   12975:          $id.'.NumSets' => 2,
1.137     matthew  12976:          $id.'.two_axes' => 1,
                   12977:          $id.'.y1_max_value' => $Max1,
                   12978:          $id.'.y1_min_value' => $Min1,
                   12979:          $id.'.y2_max_value' => $Max2,
                   12980:          $id.'.y2_min_value' => $Min2,
1.136     matthew  12981:          );
                   12982:     #
1.137     matthew  12983:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12984:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12985:     }
                   12986:     #
                   12987:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   12988:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  12989:         return '';
                   12990:     }
                   12991:     my $NumSets=1;
1.137     matthew  12992:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  12993:         next if (! ref($array));
                   12994:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  12995:     }
                   12996:     #
                   12997:     # Deal with other parameters
                   12998:     while (my ($key,$value) = each(%Values)) {
                   12999:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13000:     }
                   13001:     #
1.646     raeburn  13002:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13003:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13004: }
                   13005: 
                   13006: ############################################################
                   13007: ############################################################
                   13008: 
                   13009: =pod
                   13010: 
1.157     matthew  13011: =back 
                   13012: 
1.139     matthew  13013: =head1 Statistics helper routines?  
                   13014: 
                   13015: Bad place for them but what the hell.
                   13016: 
1.157     matthew  13017: =over 4
                   13018: 
1.648     raeburn  13019: =item * &chartlink()
1.139     matthew  13020: 
                   13021: Returns a link to the chart for a specific student.  
                   13022: 
                   13023: Inputs:
                   13024: 
                   13025: =over 4
                   13026: 
                   13027: =item $linktext: The text of the link
                   13028: 
                   13029: =item $sname: The students username
                   13030: 
                   13031: =item $sdomain: The students domain
                   13032: 
                   13033: =back
                   13034: 
1.157     matthew  13035: =back
                   13036: 
1.139     matthew  13037: =cut
                   13038: 
                   13039: ############################################################
                   13040: ############################################################
                   13041: sub chartlink {
                   13042:     my ($linktext, $sname, $sdomain) = @_;
                   13043:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13044:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13045:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13046:        '">'.$linktext.'</a>';
1.153     matthew  13047: }
                   13048: 
                   13049: #######################################################
                   13050: #######################################################
                   13051: 
                   13052: =pod
                   13053: 
                   13054: =head1 Course Environment Routines
1.157     matthew  13055: 
                   13056: =over 4
1.153     matthew  13057: 
1.648     raeburn  13058: =item * &restore_course_settings()
1.153     matthew  13059: 
1.648     raeburn  13060: =item * &store_course_settings()
1.153     matthew  13061: 
                   13062: Restores/Store indicated form parameters from the course environment.
                   13063: Will not overwrite existing values of the form parameters.
                   13064: 
                   13065: Inputs: 
                   13066: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13067: 
                   13068: a hash ref describing the data to be stored.  For example:
                   13069:    
                   13070: %Save_Parameters = ('Status' => 'scalar',
                   13071:     'chartoutputmode' => 'scalar',
                   13072:     'chartoutputdata' => 'scalar',
                   13073:     'Section' => 'array',
1.373     raeburn  13074:     'Group' => 'array',
1.153     matthew  13075:     'StudentData' => 'array',
                   13076:     'Maps' => 'array');
                   13077: 
                   13078: Returns: both routines return nothing
                   13079: 
1.631     raeburn  13080: =back
                   13081: 
1.153     matthew  13082: =cut
                   13083: 
                   13084: #######################################################
                   13085: #######################################################
                   13086: sub store_course_settings {
1.496     albertel 13087:     return &store_settings($env{'request.course.id'},@_);
                   13088: }
                   13089: 
                   13090: sub store_settings {
1.153     matthew  13091:     # save to the environment
                   13092:     # appenv the same items, just to be safe
1.300     albertel 13093:     my $udom  = $env{'user.domain'};
                   13094:     my $uname = $env{'user.name'};
1.496     albertel 13095:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13096:     my %SaveHash;
                   13097:     my %AppHash;
                   13098:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13099:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13100:         my $envname = 'environment.'.$basename;
1.258     albertel 13101:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13102:             # Save this value away
                   13103:             if ($type eq 'scalar' &&
1.258     albertel 13104:                 (! exists($env{$envname}) || 
                   13105:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13106:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13107:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13108:             } elsif ($type eq 'array') {
                   13109:                 my $stored_form;
1.258     albertel 13110:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13111:                     $stored_form = join(',',
                   13112:                                         map {
1.369     www      13113:                                             &escape($_);
1.258     albertel 13114:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13115:                 } else {
                   13116:                     $stored_form = 
1.369     www      13117:                         &escape($env{'form.'.$setting});
1.153     matthew  13118:                 }
                   13119:                 # Determine if the array contents are the same.
1.258     albertel 13120:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13121:                     $SaveHash{$basename} = $stored_form;
                   13122:                     $AppHash{$envname}   = $stored_form;
                   13123:                 }
                   13124:             }
                   13125:         }
                   13126:     }
                   13127:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13128:                                           $udom,$uname);
1.153     matthew  13129:     if ($put_result !~ /^(ok|delayed)/) {
                   13130:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13131:                                  'got error:'.$put_result);
                   13132:     }
                   13133:     # Make sure these settings stick around in this session, too
1.646     raeburn  13134:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13135:     return;
                   13136: }
                   13137: 
                   13138: sub restore_course_settings {
1.499     albertel 13139:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13140: }
                   13141: 
                   13142: sub restore_settings {
                   13143:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13144:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13145:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13146:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13147:             '.'.$setting;
1.258     albertel 13148:         if (exists($env{$envname})) {
1.153     matthew  13149:             if ($type eq 'scalar') {
1.258     albertel 13150:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13151:             } elsif ($type eq 'array') {
1.258     albertel 13152:                 $env{'form.'.$setting} = [ 
1.153     matthew  13153:                                            map { 
1.369     www      13154:                                                &unescape($_); 
1.258     albertel 13155:                                            } split(',',$env{$envname})
1.153     matthew  13156:                                            ];
                   13157:             }
                   13158:         }
                   13159:     }
1.127     matthew  13160: }
                   13161: 
1.618     raeburn  13162: #######################################################
                   13163: #######################################################
                   13164: 
                   13165: =pod
                   13166: 
                   13167: =head1 Domain E-mail Routines  
                   13168: 
                   13169: =over 4
                   13170: 
1.648     raeburn  13171: =item * &build_recipient_list()
1.618     raeburn  13172: 
1.1144    raeburn  13173: Build recipient lists for following types of e-mail:
1.766     raeburn  13174: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144    raeburn  13175: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   13176: module change checking, student/employee ID conflict checks, as
                   13177: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   13178: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  13179: 
                   13180: Inputs:
1.619     raeburn  13181: defmail (scalar - email address of default recipient), 
1.1144    raeburn  13182: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   13183: requestsmail, updatesmail, or idconflictsmail).
                   13184: 
1.619     raeburn  13185: defdom (domain for which to retrieve configuration settings),
1.1144    raeburn  13186: 
1.619     raeburn  13187: origmail (scalar - email address of recipient from loncapa.conf, 
                   13188: i.e., predates configuration by DC via domainprefs.pm 
1.618     raeburn  13189: 
1.655     raeburn  13190: Returns: comma separated list of addresses to which to send e-mail.
                   13191: 
                   13192: =back
1.618     raeburn  13193: 
                   13194: =cut
                   13195: 
                   13196: ############################################################
                   13197: ############################################################
                   13198: sub build_recipient_list {
1.619     raeburn  13199:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13200:     my @recipients;
                   13201:     my $otheremails;
                   13202:     my %domconfig =
                   13203:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13204:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13205:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13206:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13207:                 my @contacts = ('adminemail','supportemail');
                   13208:                 foreach my $item (@contacts) {
                   13209:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13210:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13211:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13212:                             push(@recipients,$addr);
                   13213:                         }
1.619     raeburn  13214:                     }
1.766     raeburn  13215:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13216:                 }
                   13217:             }
1.766     raeburn  13218:         } elsif ($origmail ne '') {
                   13219:             push(@recipients,$origmail);
1.618     raeburn  13220:         }
1.619     raeburn  13221:     } elsif ($origmail ne '') {
                   13222:         push(@recipients,$origmail);
1.618     raeburn  13223:     }
1.688     raeburn  13224:     if (defined($defmail)) {
                   13225:         if ($defmail ne '') {
                   13226:             push(@recipients,$defmail);
                   13227:         }
1.618     raeburn  13228:     }
                   13229:     if ($otheremails) {
1.619     raeburn  13230:         my @others;
                   13231:         if ($otheremails =~ /,/) {
                   13232:             @others = split(/,/,$otheremails);
1.618     raeburn  13233:         } else {
1.619     raeburn  13234:             push(@others,$otheremails);
                   13235:         }
                   13236:         foreach my $addr (@others) {
                   13237:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13238:                 push(@recipients,$addr);
                   13239:             }
1.618     raeburn  13240:         }
                   13241:     }
1.619     raeburn  13242:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13243:     return $recipientlist;
                   13244: }
                   13245: 
1.127     matthew  13246: ############################################################
                   13247: ############################################################
1.154     albertel 13248: 
1.655     raeburn  13249: =pod
                   13250: 
                   13251: =head1 Course Catalog Routines
                   13252: 
                   13253: =over 4
                   13254: 
                   13255: =item * &gather_categories()
                   13256: 
                   13257: Converts category definitions - keys of categories hash stored in  
                   13258: coursecategories in configuration.db on the primary library server in a 
                   13259: domain - to an array.  Also generates javascript and idx hash used to 
                   13260: generate Domain Coordinator interface for editing Course Categories.
                   13261: 
                   13262: Inputs:
1.663     raeburn  13263: 
1.655     raeburn  13264: categories (reference to hash of category definitions).
1.663     raeburn  13265: 
1.655     raeburn  13266: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13267:       categories and subcategories).
1.663     raeburn  13268: 
1.655     raeburn  13269: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13270:       editing Course Categories).
1.663     raeburn  13271: 
1.655     raeburn  13272: jsarray (reference to array of categories used to create Javascript arrays for
                   13273:          Domain Coordinator interface for editing Course Categories).
                   13274: 
                   13275: Returns: nothing
                   13276: 
                   13277: Side effects: populates cats, idx and jsarray. 
                   13278: 
                   13279: =cut
                   13280: 
                   13281: sub gather_categories {
                   13282:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13283:     my %counters;
                   13284:     my $num = 0;
                   13285:     foreach my $item (keys(%{$categories})) {
                   13286:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13287:         if ($container eq '' && $depth == 0) {
                   13288:             $cats->[$depth][$categories->{$item}] = $cat;
                   13289:         } else {
                   13290:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13291:         }
                   13292:         my ($escitem,$tail) = split(/:/,$item,2);
                   13293:         if ($counters{$tail} eq '') {
                   13294:             $counters{$tail} = $num;
                   13295:             $num ++;
                   13296:         }
                   13297:         if (ref($idx) eq 'HASH') {
                   13298:             $idx->{$item} = $counters{$tail};
                   13299:         }
                   13300:         if (ref($jsarray) eq 'ARRAY') {
                   13301:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13302:         }
                   13303:     }
                   13304:     return;
                   13305: }
                   13306: 
                   13307: =pod
                   13308: 
                   13309: =item * &extract_categories()
                   13310: 
                   13311: Used to generate breadcrumb trails for course categories.
                   13312: 
                   13313: Inputs:
1.663     raeburn  13314: 
1.655     raeburn  13315: categories (reference to hash of category definitions).
1.663     raeburn  13316: 
1.655     raeburn  13317: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13318:       categories and subcategories).
1.663     raeburn  13319: 
1.655     raeburn  13320: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  13321: 
1.655     raeburn  13322: allitems (reference to hash - key is category key 
                   13323:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13324: 
1.655     raeburn  13325: idx (reference to hash of counters used in Domain Coordinator interface for
                   13326:       editing Course Categories).
1.663     raeburn  13327: 
1.655     raeburn  13328: jsarray (reference to array of categories used to create Javascript arrays for
                   13329:          Domain Coordinator interface for editing Course Categories).
                   13330: 
1.665     raeburn  13331: subcats (reference to hash of arrays containing all subcategories within each 
                   13332:          category, -recursive)
                   13333: 
1.655     raeburn  13334: Returns: nothing
                   13335: 
                   13336: Side effects: populates trails and allitems hash references.
                   13337: 
                   13338: =cut
                   13339: 
                   13340: sub extract_categories {
1.665     raeburn  13341:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  13342:     if (ref($categories) eq 'HASH') {
                   13343:         &gather_categories($categories,$cats,$idx,$jsarray);
                   13344:         if (ref($cats->[0]) eq 'ARRAY') {
                   13345:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   13346:                 my $name = $cats->[0][$i];
                   13347:                 my $item = &escape($name).'::0';
                   13348:                 my $trailstr;
                   13349:                 if ($name eq 'instcode') {
                   13350:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  13351:                 } elsif ($name eq 'communities') {
                   13352:                     $trailstr = &mt('Communities');
1.655     raeburn  13353:                 } else {
                   13354:                     $trailstr = $name;
                   13355:                 }
                   13356:                 if ($allitems->{$item} eq '') {
                   13357:                     push(@{$trails},$trailstr);
                   13358:                     $allitems->{$item} = scalar(@{$trails})-1;
                   13359:                 }
                   13360:                 my @parents = ($name);
                   13361:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   13362:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   13363:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  13364:                         if (ref($subcats) eq 'HASH') {
                   13365:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   13366:                         }
                   13367:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   13368:                     }
                   13369:                 } else {
                   13370:                     if (ref($subcats) eq 'HASH') {
                   13371:                         $subcats->{$item} = [];
1.655     raeburn  13372:                     }
                   13373:                 }
                   13374:             }
                   13375:         }
                   13376:     }
                   13377:     return;
                   13378: }
                   13379: 
                   13380: =pod
                   13381: 
                   13382: =item *&recurse_categories()
                   13383: 
                   13384: Recursively used to generate breadcrumb trails for course categories.
                   13385: 
                   13386: Inputs:
1.663     raeburn  13387: 
1.655     raeburn  13388: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13389:       categories and subcategories).
1.663     raeburn  13390: 
1.655     raeburn  13391: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  13392: 
                   13393: category (current course category, for which breadcrumb trail is being generated).
                   13394: 
                   13395: trails (reference to array of breadcrumb trails for each category).
                   13396: 
1.655     raeburn  13397: allitems (reference to hash - key is category key
                   13398:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13399: 
1.655     raeburn  13400: parents (array containing containers directories for current category, 
                   13401:          back to top level). 
                   13402: 
                   13403: Returns: nothing
                   13404: 
                   13405: Side effects: populates trails and allitems hash references
                   13406: 
                   13407: =cut
                   13408: 
                   13409: sub recurse_categories {
1.665     raeburn  13410:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  13411:     my $shallower = $depth - 1;
                   13412:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   13413:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   13414:             my $name = $cats->[$depth]{$category}[$k];
                   13415:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13416:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13417:             if ($allitems->{$item} eq '') {
                   13418:                 push(@{$trails},$trailstr);
                   13419:                 $allitems->{$item} = scalar(@{$trails})-1;
                   13420:             }
                   13421:             my $deeper = $depth+1;
                   13422:             push(@{$parents},$category);
1.665     raeburn  13423:             if (ref($subcats) eq 'HASH') {
                   13424:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   13425:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   13426:                     my $higher;
                   13427:                     if ($j > 0) {
                   13428:                         $higher = &escape($parents->[$j]).':'.
                   13429:                                   &escape($parents->[$j-1]).':'.$j;
                   13430:                     } else {
                   13431:                         $higher = &escape($parents->[$j]).'::'.$j;
                   13432:                     }
                   13433:                     push(@{$subcats->{$higher}},$subcat);
                   13434:                 }
                   13435:             }
                   13436:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   13437:                                 $subcats);
1.655     raeburn  13438:             pop(@{$parents});
                   13439:         }
                   13440:     } else {
                   13441:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13442:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13443:         if ($allitems->{$item} eq '') {
                   13444:             push(@{$trails},$trailstr);
                   13445:             $allitems->{$item} = scalar(@{$trails})-1;
                   13446:         }
                   13447:     }
                   13448:     return;
                   13449: }
                   13450: 
1.663     raeburn  13451: =pod
                   13452: 
                   13453: =item *&assign_categories_table()
                   13454: 
                   13455: Create a datatable for display of hierarchical categories in a domain,
                   13456: with checkboxes to allow a course to be categorized. 
                   13457: 
                   13458: Inputs:
                   13459: 
                   13460: cathash - reference to hash of categories defined for the domain (from
                   13461:           configuration.db)
                   13462: 
                   13463: currcat - scalar with an & separated list of categories assigned to a course. 
                   13464: 
1.919     raeburn  13465: type    - scalar contains course type (Course or Community).
                   13466: 
1.663     raeburn  13467: Returns: $output (markup to be displayed) 
                   13468: 
                   13469: =cut
                   13470: 
                   13471: sub assign_categories_table {
1.919     raeburn  13472:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13473:     my $output;
                   13474:     if (ref($cathash) eq 'HASH') {
                   13475:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13476:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13477:         $maxdepth = scalar(@cats);
                   13478:         if (@cats > 0) {
                   13479:             my $itemcount = 0;
                   13480:             if (ref($cats[0]) eq 'ARRAY') {
                   13481:                 my @currcategories;
                   13482:                 if ($currcat ne '') {
                   13483:                     @currcategories = split('&',$currcat);
                   13484:                 }
1.919     raeburn  13485:                 my $table;
1.663     raeburn  13486:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13487:                     my $parent = $cats[0][$i];
1.919     raeburn  13488:                     next if ($parent eq 'instcode');
                   13489:                     if ($type eq 'Community') {
                   13490:                         next unless ($parent eq 'communities');
                   13491:                     } else {
                   13492:                         next if ($parent eq 'communities');
                   13493:                     }
1.663     raeburn  13494:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13495:                     my $item = &escape($parent).'::0';
                   13496:                     my $checked = '';
                   13497:                     if (@currcategories > 0) {
                   13498:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13499:                             $checked = ' checked="checked"';
1.663     raeburn  13500:                         }
                   13501:                     }
1.919     raeburn  13502:                     my $parent_title = $parent;
                   13503:                     if ($parent eq 'communities') {
                   13504:                         $parent_title = &mt('Communities');
                   13505:                     }
                   13506:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13507:                               '<input type="checkbox" name="usecategory" value="'.
                   13508:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13509:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13510:                     my $depth = 1;
                   13511:                     push(@path,$parent);
1.919     raeburn  13512:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13513:                     pop(@path);
1.919     raeburn  13514:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13515:                     $itemcount ++;
                   13516:                 }
1.919     raeburn  13517:                 if ($itemcount) {
                   13518:                     $output = &Apache::loncommon::start_data_table().
                   13519:                               $table.
                   13520:                               &Apache::loncommon::end_data_table();
                   13521:                 }
1.663     raeburn  13522:             }
                   13523:         }
                   13524:     }
                   13525:     return $output;
                   13526: }
                   13527: 
                   13528: =pod
                   13529: 
                   13530: =item *&assign_category_rows()
                   13531: 
                   13532: Create a datatable row for display of nested categories in a domain,
                   13533: with checkboxes to allow a course to be categorized,called recursively.
                   13534: 
                   13535: Inputs:
                   13536: 
                   13537: itemcount - track row number for alternating colors
                   13538: 
                   13539: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13540:       categories and subcategories.
                   13541: 
                   13542: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13543: 
                   13544: parent - parent of current category item
                   13545: 
                   13546: path - Array containing all categories back up through the hierarchy from the
                   13547:        current category to the top level.
                   13548: 
                   13549: currcategories - reference to array of current categories assigned to the course
                   13550: 
                   13551: Returns: $output (markup to be displayed).
                   13552: 
                   13553: =cut
                   13554: 
                   13555: sub assign_category_rows {
                   13556:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13557:     my ($text,$name,$item,$chgstr);
                   13558:     if (ref($cats) eq 'ARRAY') {
                   13559:         my $maxdepth = scalar(@{$cats});
                   13560:         if (ref($cats->[$depth]) eq 'HASH') {
                   13561:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13562:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13563:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145    raeburn  13564:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  13565:                 for (my $j=0; $j<$numchildren; $j++) {
                   13566:                     $name = $cats->[$depth]{$parent}[$j];
                   13567:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13568:                     my $deeper = $depth+1;
                   13569:                     my $checked = '';
                   13570:                     if (ref($currcategories) eq 'ARRAY') {
                   13571:                         if (@{$currcategories} > 0) {
                   13572:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13573:                                 $checked = ' checked="checked"';
1.663     raeburn  13574:                             }
                   13575:                         }
                   13576:                     }
1.664     raeburn  13577:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13578:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13579:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13580:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13581:                              '</td><td>';
1.663     raeburn  13582:                     if (ref($path) eq 'ARRAY') {
                   13583:                         push(@{$path},$name);
                   13584:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13585:                         pop(@{$path});
                   13586:                     }
                   13587:                     $text .= '</td></tr>';
                   13588:                 }
                   13589:                 $text .= '</table></td>';
                   13590:             }
                   13591:         }
                   13592:     }
                   13593:     return $text;
                   13594: }
                   13595: 
1.655     raeburn  13596: ############################################################
                   13597: ############################################################
                   13598: 
                   13599: 
1.443     albertel 13600: sub commit_customrole {
1.664     raeburn  13601:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13602:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13603:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13604:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13605:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13606:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13607:                  '</b><br />';
                   13608:     return $output;
                   13609: }
                   13610: 
                   13611: sub commit_standardrole {
1.1116    raeburn  13612:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  13613:     my ($output,$logmsg,$linefeed);
                   13614:     if ($context eq 'auto') {
                   13615:         $linefeed = "\n";
                   13616:     } else {
                   13617:         $linefeed = "<br />\n";
                   13618:     }  
1.443     albertel 13619:     if ($three eq 'st') {
1.541     raeburn  13620:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116    raeburn  13621:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  13622:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13623:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13624:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13625:         } else {
1.541     raeburn  13626:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13627:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13628:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13629:             if ($context eq 'auto') {
                   13630:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13631:             } else {
                   13632:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13633:                &mt('Add to classlist').': <b>ok</b>';
                   13634:             }
                   13635:             $output .= $linefeed;
1.443     albertel 13636:         }
                   13637:     } else {
                   13638:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13639:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13640:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13641:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13642:         if ($context eq 'auto') {
                   13643:             $output .= $result.$linefeed;
                   13644:         } else {
                   13645:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13646:         }
1.443     albertel 13647:     }
                   13648:     return $output;
                   13649: }
                   13650: 
                   13651: sub commit_studentrole {
1.1116    raeburn  13652:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   13653:         $credits) = @_;
1.626     raeburn  13654:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13655:     if ($context eq 'auto') {
                   13656:         $linefeed = "\n";
                   13657:     } else {
                   13658:         $linefeed = '<br />'."\n";
                   13659:     }
1.443     albertel 13660:     if (defined($one) && defined($two)) {
                   13661:         my $cid=$one.'_'.$two;
                   13662:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13663:         my $secchange = 0;
                   13664:         my $expire_role_result;
                   13665:         my $modify_section_result;
1.628     raeburn  13666:         if ($oldsec ne '-1') { 
                   13667:             if ($oldsec ne $sec) {
1.443     albertel 13668:                 $secchange = 1;
1.628     raeburn  13669:                 my $now = time;
1.443     albertel 13670:                 my $uurl='/'.$cid;
                   13671:                 $uurl=~s/\_/\//g;
                   13672:                 if ($oldsec) {
                   13673:                     $uurl.='/'.$oldsec;
                   13674:                 }
1.626     raeburn  13675:                 $oldsecurl = $uurl;
1.628     raeburn  13676:                 $expire_role_result = 
1.652     raeburn  13677:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13678:                 if ($env{'request.course.sec'} ne '') { 
                   13679:                     if ($expire_role_result eq 'refused') {
                   13680:                         my @roles = ('st');
                   13681:                         my @statuses = ('previous');
                   13682:                         my @roledoms = ($one);
                   13683:                         my $withsec = 1;
                   13684:                         my %roleshash = 
                   13685:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13686:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13687:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13688:                             my ($oldstart,$oldend) = 
                   13689:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13690:                             if ($oldend > 0 && $oldend <= $now) {
                   13691:                                 $expire_role_result = 'ok';
                   13692:                             }
                   13693:                         }
                   13694:                     }
                   13695:                 }
1.443     albertel 13696:                 $result = $expire_role_result;
                   13697:             }
                   13698:         }
                   13699:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116    raeburn  13700:             $modify_section_result = 
                   13701:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   13702:                                                            undef,undef,undef,$sec,
                   13703:                                                            $end,$start,'','',$cid,
                   13704:                                                            '',$context,$credits);
1.443     albertel 13705:             if ($modify_section_result =~ /^ok/) {
                   13706:                 if ($secchange == 1) {
1.628     raeburn  13707:                     if ($sec eq '') {
                   13708:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13709:                     } else {
                   13710:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13711:                     }
1.443     albertel 13712:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13713:                     if ($sec eq '') {
                   13714:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13715:                     } else {
                   13716:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13717:                     }
1.443     albertel 13718:                 } else {
1.628     raeburn  13719:                     if ($sec eq '') {
                   13720:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13721:                     } else {
                   13722:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13723:                     }
1.443     albertel 13724:                 }
                   13725:             } else {
1.1115    raeburn  13726:                 if ($secchange) { 
1.628     raeburn  13727:                     $$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;
                   13728:                 } else {
                   13729:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13730:                 }
1.443     albertel 13731:             }
                   13732:             $result = $modify_section_result;
                   13733:         } elsif ($secchange == 1) {
1.628     raeburn  13734:             if ($oldsec eq '') {
1.1103    raeburn  13735:                 $$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  13736:             } else {
                   13737:                 $$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;
                   13738:             }
1.626     raeburn  13739:             if ($expire_role_result eq 'refused') {
                   13740:                 my $newsecurl = '/'.$cid;
                   13741:                 $newsecurl =~ s/\_/\//g;
                   13742:                 if ($sec ne '') {
                   13743:                     $newsecurl.='/'.$sec;
                   13744:                 }
                   13745:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13746:                     if ($sec eq '') {
                   13747:                         $$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;
                   13748:                     } else {
                   13749:                         $$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;
                   13750:                     }
                   13751:                 }
                   13752:             }
1.443     albertel 13753:         }
                   13754:     } else {
1.626     raeburn  13755:         $$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 13756:         $result = "error: incomplete course id\n";
                   13757:     }
                   13758:     return $result;
                   13759: }
                   13760: 
1.1108    raeburn  13761: sub show_role_extent {
                   13762:     my ($scope,$context,$role) = @_;
                   13763:     $scope =~ s{^/}{};
                   13764:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   13765:     push(@courseroles,'co');
                   13766:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   13767:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   13768:         $scope =~ s{/}{_};
                   13769:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   13770:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   13771:         my ($audom,$auname) = split(/\//,$scope);
                   13772:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   13773:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   13774:     } else {
                   13775:         $scope =~ s{/$}{};
                   13776:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   13777:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   13778:     }
                   13779: }
                   13780: 
1.443     albertel 13781: ############################################################
                   13782: ############################################################
                   13783: 
1.566     albertel 13784: sub check_clone {
1.578     raeburn  13785:     my ($args,$linefeed) = @_;
1.566     albertel 13786:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13787:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13788:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13789:     my $clonemsg;
                   13790:     my $can_clone = 0;
1.944     raeburn  13791:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13792:     if ($lctype ne 'community') {
                   13793:         $lctype = 'course';
                   13794:     }
1.566     albertel 13795:     if ($clonehome eq 'no_host') {
1.944     raeburn  13796:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13797:             $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'});
                   13798:         } else {
                   13799:             $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'});
                   13800:         }     
1.566     albertel 13801:     } else {
                   13802: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13803:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13804:             if ($clonedesc{'type'} ne 'Community') {
                   13805:                  $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'});
                   13806:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13807:             }
                   13808:         }
1.882     raeburn  13809: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13810:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13811: 	    $can_clone = 1;
                   13812: 	} else {
                   13813: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13814: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13815: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13816:             if (grep(/^\*$/,@cloners)) {
                   13817:                 $can_clone = 1;
                   13818:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13819:                 $can_clone = 1;
                   13820:             } else {
1.908     raeburn  13821:                 my $ccrole = 'cc';
1.944     raeburn  13822:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13823:                     $ccrole = 'co';
                   13824:                 }
1.578     raeburn  13825: 	        my %roleshash =
                   13826: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13827: 					 $args->{'ccdomain'},
1.908     raeburn  13828:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13829: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13830: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13831:                     $can_clone = 1;
                   13832:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13833:                     $can_clone = 1;
                   13834:                 } else {
1.944     raeburn  13835:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13836:                         $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'});
                   13837:                     } else {
                   13838:                         $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'});
                   13839:                     }
1.578     raeburn  13840: 	        }
1.566     albertel 13841: 	    }
1.578     raeburn  13842:         }
1.566     albertel 13843:     }
                   13844:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13845: }
                   13846: 
1.444     albertel 13847: sub construct_course {
1.885     raeburn  13848:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
1.444     albertel 13849:     my $outcome;
1.541     raeburn  13850:     my $linefeed =  '<br />'."\n";
                   13851:     if ($context eq 'auto') {
                   13852:         $linefeed = "\n";
                   13853:     }
1.566     albertel 13854: 
                   13855: #
                   13856: # Are we cloning?
                   13857: #
                   13858:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13859:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13860: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13861: 	if ($context ne 'auto') {
1.578     raeburn  13862:             if ($clonemsg ne '') {
                   13863: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13864:             }
1.566     albertel 13865: 	}
                   13866: 	$outcome .= $clonemsg.$linefeed;
                   13867: 
                   13868:         if (!$can_clone) {
                   13869: 	    return (0,$outcome);
                   13870: 	}
                   13871:     }
                   13872: 
1.444     albertel 13873: #
                   13874: # Open course
                   13875: #
                   13876:     my $crstype = lc($args->{'crstype'});
                   13877:     my %cenv=();
                   13878:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13879:                                              $args->{'cdescr'},
                   13880:                                              $args->{'curl'},
                   13881:                                              $args->{'course_home'},
                   13882:                                              $args->{'nonstandard'},
                   13883:                                              $args->{'crscode'},
                   13884:                                              $args->{'ccuname'}.':'.
                   13885:                                              $args->{'ccdomain'},
1.882     raeburn  13886:                                              $args->{'crstype'},
1.885     raeburn  13887:                                              $cnum,$context,$category);
1.444     albertel 13888: 
                   13889:     # Note: The testing routines depend on this being output; see 
                   13890:     # Utils::Course. This needs to at least be output as a comment
                   13891:     # if anyone ever decides to not show this, and Utils::Course::new
                   13892:     # will need to be suitably modified.
1.541     raeburn  13893:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13894:     if ($$courseid =~ /^error:/) {
                   13895:         return (0,$outcome);
                   13896:     }
                   13897: 
1.444     albertel 13898: #
                   13899: # Check if created correctly
                   13900: #
1.479     albertel 13901:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13902:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13903:     if ($crsuhome eq 'no_host') {
                   13904:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13905:         return (0,$outcome);
                   13906:     }
1.541     raeburn  13907:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13908: 
1.444     albertel 13909: #
1.566     albertel 13910: # Do the cloning
                   13911: #   
                   13912:     if ($can_clone && $cloneid) {
                   13913: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13914: 	if ($context ne 'auto') {
                   13915: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13916: 	}
                   13917: 	$outcome .= $clonemsg.$linefeed;
                   13918: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13919: # Copy all files
1.637     www      13920: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 13921: # Restore URL
1.566     albertel 13922: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 13923: # Restore title
1.566     albertel 13924: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  13925: # Restore creation date, creator and creation context.
                   13926:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   13927:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   13928:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 13929: # Mark as cloned
1.566     albertel 13930: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      13931: # Need to clone grading mode
                   13932:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   13933:         $cenv{'grading'}=$newenv{'grading'};
                   13934: # Do not clone these environment entries
                   13935:         &Apache::lonnet::del('environment',
                   13936:                   ['default_enrollment_start_date',
                   13937:                    'default_enrollment_end_date',
                   13938:                    'question.email',
                   13939:                    'policy.email',
                   13940:                    'comment.email',
                   13941:                    'pch.users.denied',
1.725     raeburn  13942:                    'plc.users.denied',
                   13943:                    'hidefromcat',
1.1121    raeburn  13944:                    'checkforpriv',
1.725     raeburn  13945:                    'categories'],
1.638     www      13946:                    $$crsudom,$$crsunum);
1.444     albertel 13947:     }
1.566     albertel 13948: 
1.444     albertel 13949: #
                   13950: # Set environment (will override cloned, if existing)
                   13951: #
                   13952:     my @sections = ();
                   13953:     my @xlists = ();
                   13954:     if ($args->{'crstype'}) {
                   13955:         $cenv{'type'}=$args->{'crstype'};
                   13956:     }
                   13957:     if ($args->{'crsid'}) {
                   13958:         $cenv{'courseid'}=$args->{'crsid'};
                   13959:     }
                   13960:     if ($args->{'crscode'}) {
                   13961:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   13962:     }
                   13963:     if ($args->{'crsquota'} ne '') {
                   13964:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   13965:     } else {
                   13966:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   13967:     }
                   13968:     if ($args->{'ccuname'}) {
                   13969:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   13970:                                         ':'.$args->{'ccdomain'};
                   13971:     } else {
                   13972:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   13973:     }
1.1116    raeburn  13974:     if ($args->{'defaultcredits'}) {
                   13975:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   13976:     }
1.444     albertel 13977:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   13978:     if ($args->{'crssections'}) {
                   13979:         $cenv{'internal.sectionnums'} = '';
                   13980:         if ($args->{'crssections'} =~ m/,/) {
                   13981:             @sections = split/,/,$args->{'crssections'};
                   13982:         } else {
                   13983:             $sections[0] = $args->{'crssections'};
                   13984:         }
                   13985:         if (@sections > 0) {
                   13986:             foreach my $item (@sections) {
                   13987:                 my ($sec,$gp) = split/:/,$item;
                   13988:                 my $class = $args->{'crscode'}.$sec;
                   13989:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   13990:                 $cenv{'internal.sectionnums'} .= $item.',';
                   13991:                 unless ($addcheck eq 'ok') {
                   13992:                     push @badclasses, $class;
                   13993:                 }
                   13994:             }
                   13995:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   13996:         }
                   13997:     }
                   13998: # do not hide course coordinator from staff listing, 
                   13999: # even if privileged
                   14000:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121    raeburn  14001: # add course coordinator's domain to domains to check for privileged users
                   14002: # if different to course domain
                   14003:     if ($$crsudom ne $args->{'ccdomain'}) {
                   14004:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   14005:     }
1.444     albertel 14006: # add crosslistings
                   14007:     if ($args->{'crsxlist'}) {
                   14008:         $cenv{'internal.crosslistings'}='';
                   14009:         if ($args->{'crsxlist'} =~ m/,/) {
                   14010:             @xlists = split/,/,$args->{'crsxlist'};
                   14011:         } else {
                   14012:             $xlists[0] = $args->{'crsxlist'};
                   14013:         }
                   14014:         if (@xlists > 0) {
                   14015:             foreach my $item (@xlists) {
                   14016:                 my ($xl,$gp) = split/:/,$item;
                   14017:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   14018:                 $cenv{'internal.crosslistings'} .= $item.',';
                   14019:                 unless ($addcheck eq 'ok') {
                   14020:                     push @badclasses, $xl;
                   14021:                 }
                   14022:             }
                   14023:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   14024:         }
                   14025:     }
                   14026:     if ($args->{'autoadds'}) {
                   14027:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   14028:     }
                   14029:     if ($args->{'autodrops'}) {
                   14030:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   14031:     }
                   14032: # check for notification of enrollment changes
                   14033:     my @notified = ();
                   14034:     if ($args->{'notify_owner'}) {
                   14035:         if ($args->{'ccuname'} ne '') {
                   14036:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   14037:         }
                   14038:     }
                   14039:     if ($args->{'notify_dc'}) {
                   14040:         if ($uname ne '') { 
1.630     raeburn  14041:             push(@notified,$uname.':'.$udom);
1.444     albertel 14042:         }
                   14043:     }
                   14044:     if (@notified > 0) {
                   14045:         my $notifylist;
                   14046:         if (@notified > 1) {
                   14047:             $notifylist = join(',',@notified);
                   14048:         } else {
                   14049:             $notifylist = $notified[0];
                   14050:         }
                   14051:         $cenv{'internal.notifylist'} = $notifylist;
                   14052:     }
                   14053:     if (@badclasses > 0) {
                   14054:         my %lt=&Apache::lonlocal::texthash(
                   14055:                 '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',
                   14056:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   14057:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   14058:         );
1.541     raeburn  14059:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   14060:                            ' ('.$lt{'adby'}.')';
                   14061:         if ($context eq 'auto') {
                   14062:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 14063:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  14064:             foreach my $item (@badclasses) {
                   14065:                 if ($context eq 'auto') {
                   14066:                     $outcome .= " - $item\n";
                   14067:                 } else {
                   14068:                     $outcome .= "<li>$item</li>\n";
                   14069:                 }
                   14070:             }
                   14071:             if ($context eq 'auto') {
                   14072:                 $outcome .= $linefeed;
                   14073:             } else {
1.566     albertel 14074:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14075:             }
                   14076:         } 
1.444     albertel 14077:     }
                   14078:     if ($args->{'no_end_date'}) {
                   14079:         $args->{'endaccess'} = 0;
                   14080:     }
                   14081:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14082:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14083:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14084:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14085:     if ($args->{'showphotos'}) {
                   14086:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14087:     }
                   14088:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14089:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14090:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14091:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14092:             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'); 
                   14093:             if ($context eq 'auto') {
                   14094:                 $outcome .= $krb_msg;
                   14095:             } else {
1.566     albertel 14096:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14097:             }
                   14098:             $outcome .= $linefeed;
1.444     albertel 14099:         }
                   14100:     }
                   14101:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14102:        if ($args->{'setpolicy'}) {
                   14103:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14104:        }
                   14105:        if ($args->{'setcontent'}) {
                   14106:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14107:        }
                   14108:     }
                   14109:     if ($args->{'reshome'}) {
                   14110: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14111: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14112:     }
                   14113: #
                   14114: # course has keyed access
                   14115: #
                   14116:     if ($args->{'setkeys'}) {
                   14117:        $cenv{'keyaccess'}='yes';
                   14118:     }
                   14119: # if specified, key authority is not course, but user
                   14120: # only active if keyaccess is yes
                   14121:     if ($args->{'keyauth'}) {
1.487     albertel 14122: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14123: 	$user = &LONCAPA::clean_username($user);
                   14124: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14125: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14126: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14127: 	}
                   14128:     }
                   14129: 
                   14130:     if ($args->{'disresdis'}) {
                   14131:         $cenv{'pch.roles.denied'}='st';
                   14132:     }
                   14133:     if ($args->{'disablechat'}) {
                   14134:         $cenv{'plc.roles.denied'}='st';
                   14135:     }
                   14136: 
                   14137:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14138:     # course
                   14139:     $cenv{'course.helper.not.run'} = 1;
                   14140:     #
                   14141:     # Use new Randomseed
                   14142:     #
                   14143:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14144:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14145:     #
                   14146:     # The encryption code and receipt prefix for this course
                   14147:     #
                   14148:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14149:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14150:     #
                   14151:     # By default, use standard grading
                   14152:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14153: 
1.541     raeburn  14154:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14155:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14156: #
                   14157: # Open all assignments
                   14158: #
                   14159:     if ($args->{'openall'}) {
                   14160:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14161:        my %storecontent = ($storeunder         => time,
                   14162:                            $storeunder.'.type' => 'date_start');
                   14163:        
                   14164:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14165:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14166:    }
                   14167: #
                   14168: # Set first page
                   14169: #
                   14170:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14171: 	    || ($cloneid)) {
1.445     albertel 14172: 	use LONCAPA::map;
1.444     albertel 14173: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14174: 
                   14175: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14176:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14177: 
1.444     albertel 14178:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14179:         my $title; my $url;
                   14180:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14181: 	    $title=&mt('Syllabus');
1.444     albertel 14182:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14183:         } else {
1.963     raeburn  14184:             $title=&mt('Table of Contents');
1.444     albertel 14185:             $url='/adm/navmaps';
                   14186:         }
1.445     albertel 14187: 
                   14188:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14189: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14190: 
                   14191: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14192:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14193:     }
1.566     albertel 14194: 
                   14195:     return (1,$outcome);
1.444     albertel 14196: }
                   14197: 
                   14198: ############################################################
                   14199: ############################################################
                   14200: 
1.953     droeschl 14201: #SD
                   14202: # only Community and Course, or anything else?
1.378     raeburn  14203: sub course_type {
                   14204:     my ($cid) = @_;
                   14205:     if (!defined($cid)) {
                   14206:         $cid = $env{'request.course.id'};
                   14207:     }
1.404     albertel 14208:     if (defined($env{'course.'.$cid.'.type'})) {
                   14209:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  14210:     } else {
                   14211:         return 'Course';
1.377     raeburn  14212:     }
                   14213: }
1.156     albertel 14214: 
1.406     raeburn  14215: sub group_term {
                   14216:     my $crstype = &course_type();
                   14217:     my %names = (
                   14218:                   'Course' => 'group',
1.865     raeburn  14219:                   'Community' => 'group',
1.406     raeburn  14220:                 );
                   14221:     return $names{$crstype};
                   14222: }
                   14223: 
1.902     raeburn  14224: sub course_types {
                   14225:     my @types = ('official','unofficial','community');
                   14226:     my %typename = (
                   14227:                          official   => 'Official course',
                   14228:                          unofficial => 'Unofficial course',
                   14229:                          community  => 'Community',
                   14230:                    );
                   14231:     return (\@types,\%typename);
                   14232: }
                   14233: 
1.156     albertel 14234: sub icon {
                   14235:     my ($file)=@_;
1.505     albertel 14236:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 14237:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 14238:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 14239:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   14240: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   14241: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14242: 	            $curfext.".gif") {
                   14243: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14244: 		$curfext.".gif";
                   14245: 	}
                   14246:     }
1.249     albertel 14247:     return &lonhttpdurl($iconname);
1.154     albertel 14248: } 
1.84      albertel 14249: 
1.575     albertel 14250: sub lonhttpdurl {
1.692     www      14251: #
                   14252: # Had been used for "small fry" static images on separate port 8080.
                   14253: # Modify here if lightweight http functionality desired again.
                   14254: # Currently eliminated due to increasing firewall issues.
                   14255: #
1.575     albertel 14256:     my ($url)=@_;
1.692     www      14257:     return $url;
1.215     albertel 14258: }
                   14259: 
1.213     albertel 14260: sub connection_aborted {
                   14261:     my ($r)=@_;
                   14262:     $r->print(" ");$r->rflush();
                   14263:     my $c = $r->connection;
                   14264:     return $c->aborted();
                   14265: }
                   14266: 
1.221     foxr     14267: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     14268: #    strings as 'strings'.
                   14269: sub escape_single {
1.221     foxr     14270:     my ($input) = @_;
1.223     albertel 14271:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     14272:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   14273:     return $input;
                   14274: }
1.223     albertel 14275: 
1.222     foxr     14276: #  Same as escape_single, but escape's "'s  This 
                   14277: #  can be used for  "strings"
                   14278: sub escape_double {
                   14279:     my ($input) = @_;
                   14280:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   14281:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   14282:     return $input;
                   14283: }
1.223     albertel 14284:  
1.222     foxr     14285: #   Escapes the last element of a full URL.
                   14286: sub escape_url {
                   14287:     my ($url)   = @_;
1.238     raeburn  14288:     my @urlslices = split(/\//, $url,-1);
1.369     www      14289:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 14290:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     14291: }
1.462     albertel 14292: 
1.820     raeburn  14293: sub compare_arrays {
                   14294:     my ($arrayref1,$arrayref2) = @_;
                   14295:     my (@difference,%count);
                   14296:     @difference = ();
                   14297:     %count = ();
                   14298:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   14299:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   14300:         foreach my $element (keys(%count)) {
                   14301:             if ($count{$element} == 1) {
                   14302:                 push(@difference,$element);
                   14303:             }
                   14304:         }
                   14305:     }
                   14306:     return @difference;
                   14307: }
                   14308: 
1.817     bisitz   14309: # -------------------------------------------------------- Initialize user login
1.462     albertel 14310: sub init_user_environment {
1.463     albertel 14311:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 14312:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   14313: 
                   14314:     my $public=($username eq 'public' && $domain eq 'public');
                   14315: 
                   14316: # See if old ID present, if so, remove
                   14317: 
1.1062    raeburn  14318:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 14319:     my $now=time;
                   14320: 
                   14321:     if ($public) {
                   14322: 	my $max_public=100;
                   14323: 	my $oldest;
                   14324: 	my $oldest_time=0;
                   14325: 	for(my $next=1;$next<=$max_public;$next++) {
                   14326: 	    if (-e $lonids."/publicuser_$next.id") {
                   14327: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   14328: 		if ($mtime<$oldest_time || !$oldest_time) {
                   14329: 		    $oldest_time=$mtime;
                   14330: 		    $oldest=$next;
                   14331: 		}
                   14332: 	    } else {
                   14333: 		$cookie="publicuser_$next";
                   14334: 		last;
                   14335: 	    }
                   14336: 	}
                   14337: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   14338:     } else {
1.463     albertel 14339: 	# if this isn't a robot, kill any existing non-robot sessions
                   14340: 	if (!$args->{'robot'}) {
                   14341: 	    opendir(DIR,$lonids);
                   14342: 	    while ($filename=readdir(DIR)) {
                   14343: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   14344: 		    unlink($lonids.'/'.$filename);
                   14345: 		}
1.462     albertel 14346: 	    }
1.463     albertel 14347: 	    closedir(DIR);
1.462     albertel 14348: 	}
                   14349: # Give them a new cookie
1.463     albertel 14350: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      14351: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 14352: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 14353:     
                   14354: # Initialize roles
                   14355: 
1.1062    raeburn  14356: 	($userroles,$firstaccenv,$timerintenv) = 
                   14357:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 14358:     }
                   14359: # ------------------------------------ Check browser type and MathML capability
                   14360: 
                   14361:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1141    raeburn  14362:         $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
1.462     albertel 14363: 
                   14364: # ------------------------------------------------------------- Get environment
                   14365: 
                   14366:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   14367:     my ($tmp) = keys(%userenv);
                   14368:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   14369:     } else {
                   14370: 	undef(%userenv);
                   14371:     }
                   14372:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   14373: 	$form->{'interface'}=$userenv{'interface'};
                   14374:     }
                   14375:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   14376: 
                   14377: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   14378:     foreach my $option ('interface','localpath','localres') {
                   14379:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 14380:     }
                   14381: # --------------------------------------------------------- Write first profile
                   14382: 
                   14383:     {
                   14384: 	my %initial_env = 
                   14385: 	    ("user.name"          => $username,
                   14386: 	     "user.domain"        => $domain,
                   14387: 	     "user.home"          => $authhost,
                   14388: 	     "browser.type"       => $clientbrowser,
                   14389: 	     "browser.version"    => $clientversion,
                   14390: 	     "browser.mathml"     => $clientmathml,
                   14391: 	     "browser.unicode"    => $clientunicode,
                   14392: 	     "browser.os"         => $clientos,
1.1137    raeburn  14393:              "browser.mobile"     => $clientmobile,
1.1141    raeburn  14394:              "browser.info"       => $clientinfo,
1.462     albertel 14395: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   14396: 	     "request.course.fn"  => '',
                   14397: 	     "request.course.uri" => '',
                   14398: 	     "request.course.sec" => '',
                   14399: 	     "request.role"       => 'cm',
                   14400: 	     "request.role.adv"   => $env{'user.adv'},
                   14401: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   14402: 
                   14403:         if ($form->{'localpath'}) {
                   14404: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   14405: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   14406:         }
                   14407: 	
                   14408: 	if ($form->{'interface'}) {
                   14409: 	    $form->{'interface'}=~s/\W//gs;
                   14410: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   14411: 	    $env{'browser.interface'}=$form->{'interface'};
                   14412: 	}
                   14413: 
1.981     raeburn  14414:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  14415:         my %domdef;
                   14416:         unless ($domain eq 'public') {
                   14417:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   14418:         }
1.980     raeburn  14419: 
1.1081    raeburn  14420:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  14421:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  14422:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   14423:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  14424:         }
                   14425: 
1.864     raeburn  14426:         foreach my $crstype ('official','unofficial','community') {
1.765     raeburn  14427:             $userenv{'canrequest.'.$crstype} =
                   14428:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  14429:                                                   'reload','requestcourses',
                   14430:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  14431:         }
                   14432: 
1.1092    raeburn  14433:         $userenv{'canrequest.author'} =
                   14434:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   14435:                                         'reload','requestauthor',
                   14436:                                         \%userenv,\%domdef,\%is_adv);
                   14437:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   14438:                                              $domain,$username);
                   14439:         my $reqstatus = $reqauthor{'author_status'};
                   14440:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') { 
                   14441:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   14442:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   14443:                                                   $reqauthor{'author'}{'timestamp'};
                   14444:             }
                   14445:         }
                   14446: 
1.462     albertel 14447: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  14448: 
1.462     albertel 14449: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   14450: 		 &GDBM_WRCREAT(),0640)) {
                   14451: 	    &_add_to_env(\%disk_env,\%initial_env);
                   14452: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   14453: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  14454:             if (ref($firstaccenv) eq 'HASH') {
                   14455:                 &_add_to_env(\%disk_env,$firstaccenv);
                   14456:             }
                   14457:             if (ref($timerintenv) eq 'HASH') {
                   14458:                 &_add_to_env(\%disk_env,$timerintenv);
                   14459:             }
1.463     albertel 14460: 	    if (ref($args->{'extra_env'})) {
                   14461: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   14462: 	    }
1.462     albertel 14463: 	    untie(%disk_env);
                   14464: 	} else {
1.705     tempelho 14465: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   14466: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 14467: 	    return 'error: '.$!;
                   14468: 	}
                   14469:     }
                   14470:     $env{'request.role'}='cm';
                   14471:     $env{'request.role.adv'}=$env{'user.adv'};
                   14472:     $env{'browser.type'}=$clientbrowser;
                   14473: 
                   14474:     return $cookie;
                   14475: 
                   14476: }
                   14477: 
                   14478: sub _add_to_env {
                   14479:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14480:     if (ref($env_data) eq 'HASH') {
                   14481:         while (my ($key,$value) = each(%$env_data)) {
                   14482: 	    $idf->{$prefix.$key} = $value;
                   14483: 	    $env{$prefix.$key}   = $value;
                   14484:         }
1.462     albertel 14485:     }
                   14486: }
                   14487: 
1.685     tempelho 14488: # --- Get the symbolic name of a problem and the url
                   14489: sub get_symb {
                   14490:     my ($request,$silent) = @_;
1.726     raeburn  14491:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14492:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14493:     if ($symb eq '') {
                   14494:         if (!$silent) {
1.1071    raeburn  14495:             if (ref($request)) { 
                   14496:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14497:             }
1.685     tempelho 14498:             return ();
                   14499:         }
                   14500:     }
                   14501:     &Apache::lonenc::check_decrypt(\$symb);
                   14502:     return ($symb);
                   14503: }
                   14504: 
                   14505: # --------------------------------------------------------------Get annotation
                   14506: 
                   14507: sub get_annotation {
                   14508:     my ($symb,$enc) = @_;
                   14509: 
                   14510:     my $key = $symb;
                   14511:     if (!$enc) {
                   14512:         $key =
                   14513:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14514:     }
                   14515:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14516:     return $annotation{$key};
                   14517: }
                   14518: 
                   14519: sub clean_symb {
1.731     raeburn  14520:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14521: 
                   14522:     &Apache::lonenc::check_decrypt(\$symb);
                   14523:     my $enc = $env{'request.enc'};
1.731     raeburn  14524:     if ($delete_enc) {
1.730     raeburn  14525:         delete($env{'request.enc'});
                   14526:     }
1.685     tempelho 14527: 
                   14528:     return ($symb,$enc);
                   14529: }
1.462     albertel 14530: 
1.990     raeburn  14531: sub build_release_hashes {
                   14532:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   14533:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   14534:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   14535:                   (ref($randomizetry) eq 'HASH'));
                   14536:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14537:         my ($item,$name,$value) = split(/:/,$key);
                   14538:         if ($item eq 'parameter') {
                   14539:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   14540:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   14541:                     push(@{$checkparms->{$name}},$value);
                   14542:                 }
                   14543:             } else {
                   14544:                 push(@{$checkparms->{$name}},$value);
                   14545:             }
                   14546:         } elsif ($item eq 'resourcetag') {
                   14547:             if ($name eq 'responsetype') {
                   14548:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   14549:             }
                   14550:         } elsif ($item eq 'course') {
                   14551:             if ($name eq 'crstype') {
                   14552:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   14553:             }
                   14554:         }
                   14555:     }
                   14556:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   14557:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   14558:     return;
                   14559: }
                   14560: 
1.1083    raeburn  14561: sub update_content_constraints {
                   14562:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14563:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   14564:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   14565:     my %checkresponsetypes;
                   14566:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   14567:         my ($item,$name,$value) = split(/:/,$key);
                   14568:         if ($item eq 'resourcetag') {
                   14569:             if ($name eq 'responsetype') {
                   14570:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   14571:             }
                   14572:         }
                   14573:     }
                   14574:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14575:     if (defined($navmap)) {
                   14576:         my %allresponses;
                   14577:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   14578:             my %responses = $res->responseTypes();
                   14579:             foreach my $key (keys(%responses)) {
                   14580:                 next unless(exists($checkresponsetypes{$key}));
                   14581:                 $allresponses{$key} += $responses{$key};
                   14582:             }
                   14583:         }
                   14584:         foreach my $key (keys(%allresponses)) {
                   14585:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   14586:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   14587:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   14588:             }
                   14589:         }
                   14590:         undef($navmap);
                   14591:     }
                   14592:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   14593:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   14594:     }
                   14595:     return;
                   14596: }
                   14597: 
1.1110    raeburn  14598: sub allmaps_incourse {
                   14599:     my ($cdom,$cnum,$chome,$cid) = @_;
                   14600:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   14601:         $cid = $env{'request.course.id'};
                   14602:         $cdom = $env{'course.'.$cid.'.domain'};
                   14603:         $cnum = $env{'course.'.$cid.'.num'};
                   14604:         $chome = $env{'course.'.$cid.'.home'};
                   14605:     }
                   14606:     my %allmaps = ();
                   14607:     my $lastchange =
                   14608:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   14609:     if ($lastchange > $env{'request.course.tied'}) {
                   14610:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   14611:         unless ($ferr) {
                   14612:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   14613:         }
                   14614:     }
                   14615:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14616:     if (defined($navmap)) {
                   14617:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   14618:             $allmaps{$res->src()} = 1;
                   14619:         }
                   14620:     }
                   14621:     return \%allmaps;
                   14622: }
                   14623: 
1.1083    raeburn  14624: sub parse_supplemental_title {
                   14625:     my ($title) = @_;
                   14626: 
                   14627:     my ($foldertitle,$renametitle);
                   14628:     if ($title =~ /&amp;&amp;&amp;/) {
                   14629:         $title = &HTML::Entites::decode($title);
                   14630:     }
                   14631:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   14632:         $renametitle=$4;
                   14633:         my ($time,$uname,$udom) = ($1,$2,$3);
                   14634:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   14635:         my $name =  &plainname($uname,$udom);
                   14636:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   14637:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   14638:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   14639:             $name.': <br />'.$foldertitle;
                   14640:     }
                   14641:     if (wantarray) {
                   14642:         return ($title,$foldertitle,$renametitle);
                   14643:     }
                   14644:     return $title;
                   14645: }
                   14646: 
1.1143    raeburn  14647: sub recurse_supplemental {
                   14648:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   14649:     if ($suppmap) {
                   14650:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   14651:         if ($fatal) {
                   14652:             $errors ++;
                   14653:         } else {
                   14654:             if ($#LONCAPA::map::resources > 0) {
                   14655:                 foreach my $res (@LONCAPA::map::resources) {
                   14656:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   14657:                     if (($src ne '') && ($status eq 'res')) {
1.1146    raeburn  14658:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   14659:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143    raeburn  14660:                         } else {
                   14661:                             $numfiles ++;
                   14662:                         }
                   14663:                     }
                   14664:                 }
                   14665:             }
                   14666:         }
                   14667:     }
                   14668:     return ($numfiles,$errors);
                   14669: }
                   14670: 
1.1101    raeburn  14671: sub symb_to_docspath {
                   14672:     my ($symb) = @_;
                   14673:     return unless ($symb);
                   14674:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   14675:     if ($resurl=~/\.(sequence|page)$/) {
                   14676:         $mapurl=$resurl;
                   14677:     } elsif ($resurl eq 'adm/navmaps') {
                   14678:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   14679:     }
                   14680:     my $mapresobj;
                   14681:     my $navmap = Apache::lonnavmaps::navmap->new();
                   14682:     if (ref($navmap)) {
                   14683:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   14684:     }
                   14685:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   14686:     my $type=$2;
                   14687:     my $path;
                   14688:     if (ref($mapresobj)) {
                   14689:         my $pcslist = $mapresobj->map_hierarchy();
                   14690:         if ($pcslist ne '') {
                   14691:             foreach my $pc (split(/,/,$pcslist)) {
                   14692:                 next if ($pc <= 1);
                   14693:                 my $res = $navmap->getByMapPc($pc);
                   14694:                 if (ref($res)) {
                   14695:                     my $thisurl = $res->src();
                   14696:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   14697:                     my $thistitle = $res->title();
                   14698:                     $path .= '&'.
                   14699:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146    raeburn  14700:                              &escape($thistitle).
1.1101    raeburn  14701:                              ':'.$res->randompick().
                   14702:                              ':'.$res->randomout().
                   14703:                              ':'.$res->encrypted().
                   14704:                              ':'.$res->randomorder().
                   14705:                              ':'.$res->is_page();
                   14706:                 }
                   14707:             }
                   14708:         }
                   14709:         $path =~ s/^\&//;
                   14710:         my $maptitle = $mapresobj->title();
                   14711:         if ($mapurl eq 'default') {
1.1129    raeburn  14712:             $maptitle = 'Main Content';
1.1101    raeburn  14713:         }
                   14714:         $path .= (($path ne '')? '&' : '').
                   14715:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  14716:                  &escape($maptitle).
1.1101    raeburn  14717:                  ':'.$mapresobj->randompick().
                   14718:                  ':'.$mapresobj->randomout().
                   14719:                  ':'.$mapresobj->encrypted().
                   14720:                  ':'.$mapresobj->randomorder().
                   14721:                  ':'.$mapresobj->is_page();
                   14722:     } else {
                   14723:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   14724:         my $ispage = (($type eq 'page')? 1 : '');
                   14725:         if ($mapurl eq 'default') {
1.1129    raeburn  14726:             $maptitle = 'Main Content';
1.1101    raeburn  14727:         }
                   14728:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146    raeburn  14729:                 &escape($maptitle).':::::'.$ispage;
1.1101    raeburn  14730:     }
                   14731:     unless ($mapurl eq 'default') {
                   14732:         $path = 'default&'.
1.1146    raeburn  14733:                 &escape('Main Content').
1.1101    raeburn  14734:                 ':::::&'.$path;
                   14735:     }
                   14736:     return $path;
                   14737: }
                   14738: 
1.1094    raeburn  14739: sub captcha_display {
                   14740:     my ($context,$lonhost) = @_;
                   14741:     my ($output,$error);
                   14742:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  14743:     if ($captcha eq 'original') {
1.1094    raeburn  14744:         $output = &create_captcha();
                   14745:         unless ($output) {
                   14746:             $error = 'captcha'; 
                   14747:         }
                   14748:     } elsif ($captcha eq 'recaptcha') {
                   14749:         $output = &create_recaptcha($pubkey);
                   14750:         unless ($output) {
1.1095    raeburn  14751:             $error = 'recaptcha'; 
1.1094    raeburn  14752:         }
                   14753:     }
                   14754:     return ($output,$error);
                   14755: }
                   14756: 
                   14757: sub captcha_response {
                   14758:     my ($context,$lonhost) = @_;
                   14759:     my ($captcha_chk,$captcha_error);
                   14760:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095    raeburn  14761:     if ($captcha eq 'original') {
1.1094    raeburn  14762:         ($captcha_chk,$captcha_error) = &check_captcha();
                   14763:     } elsif ($captcha eq 'recaptcha') {
                   14764:         $captcha_chk = &check_recaptcha($privkey);
                   14765:     } else {
                   14766:         $captcha_chk = 1;
                   14767:     }
                   14768:     return ($captcha_chk,$captcha_error);
                   14769: }
                   14770: 
                   14771: sub get_captcha_config {
                   14772:     my ($context,$lonhost) = @_;
1.1095    raeburn  14773:     my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094    raeburn  14774:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   14775:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   14776:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095    raeburn  14777:     if ($context eq 'usercreation') {
                   14778:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   14779:         if (ref($domconfig{$context}) eq 'HASH') {
                   14780:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   14781:             if (ref($hashtocheck) eq 'HASH') {
                   14782:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   14783:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   14784:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   14785:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   14786:                     }
                   14787:                     if ($privkey && $pubkey) {
                   14788:                         $captcha = 'recaptcha';
                   14789:                     } else {
                   14790:                         $captcha = 'original';
                   14791:                     }
                   14792:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   14793:                     $captcha = 'original';
                   14794:                 }
1.1094    raeburn  14795:             }
1.1095    raeburn  14796:         } else {
                   14797:             $captcha = 'captcha';
                   14798:         }
                   14799:     } elsif ($context eq 'login') {
                   14800:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   14801:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   14802:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   14803:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094    raeburn  14804:             if ($privkey && $pubkey) {
                   14805:                 $captcha = 'recaptcha';
1.1095    raeburn  14806:             } else {
                   14807:                 $captcha = 'original';
1.1094    raeburn  14808:             }
1.1095    raeburn  14809:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   14810:             $captcha = 'original';
1.1094    raeburn  14811:         }
                   14812:     }
                   14813:     return ($captcha,$pubkey,$privkey);
                   14814: }
                   14815: 
                   14816: sub create_captcha {
                   14817:     my %captcha_params = &captcha_settings();
                   14818:     my ($output,$maxtries,$tries) = ('',10,0);
                   14819:     while ($tries < $maxtries) {
                   14820:         $tries ++;
                   14821:         my $captcha = Authen::Captcha->new (
                   14822:                                            output_folder => $captcha_params{'output_dir'},
                   14823:                                            data_folder   => $captcha_params{'db_dir'},
                   14824:                                           );
                   14825:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   14826: 
                   14827:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   14828:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   14829:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
                   14830:                      '<input type="text" size="5" name="code" value="" /><br />'.
                   14831:                      '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
                   14832:             last;
                   14833:         }
                   14834:     }
                   14835:     return $output;
                   14836: }
                   14837: 
                   14838: sub captcha_settings {
                   14839:     my %captcha_params = (
                   14840:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   14841:                            www_output_dir => "/captchaspool",
                   14842:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   14843:                            numchars       => '5',
                   14844:                          );
                   14845:     return %captcha_params;
                   14846: }
                   14847: 
                   14848: sub check_captcha {
                   14849:     my ($captcha_chk,$captcha_error);
                   14850:     my $code = $env{'form.code'};
                   14851:     my $md5sum = $env{'form.crypt'};
                   14852:     my %captcha_params = &captcha_settings();
                   14853:     my $captcha = Authen::Captcha->new(
                   14854:                       output_folder => $captcha_params{'output_dir'},
                   14855:                       data_folder   => $captcha_params{'db_dir'},
                   14856:                   );
1.1109    raeburn  14857:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094    raeburn  14858:     my %captcha_hash = (
                   14859:                         0       => 'Code not checked (file error)',
                   14860:                        -1      => 'Failed: code expired',
                   14861:                        -2      => 'Failed: invalid code (not in database)',
                   14862:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   14863:     );
                   14864:     if ($captcha_chk != 1) {
                   14865:         $captcha_error = $captcha_hash{$captcha_chk}
                   14866:     }
                   14867:     return ($captcha_chk,$captcha_error);
                   14868: }
                   14869: 
                   14870: sub create_recaptcha {
                   14871:     my ($pubkey) = @_;
                   14872:     my $captcha = Captcha::reCAPTCHA->new;
                   14873:     return $captcha->get_options_setter({theme => 'white'})."\n".
                   14874:            $captcha->get_html($pubkey).
                   14875:            &mt('If either word is hard to read, [_1] will replace them.',
1.1133    raeburn  14876:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1094    raeburn  14877:            '<br /><br />';
                   14878: }
                   14879: 
                   14880: sub check_recaptcha {
                   14881:     my ($privkey) = @_;
                   14882:     my $captcha_chk;
                   14883:     my $captcha = Captcha::reCAPTCHA->new;
                   14884:     my $captcha_result =
                   14885:         $captcha->check_answer(
                   14886:                                 $privkey,
                   14887:                                 $ENV{'REMOTE_ADDR'},
                   14888:                                 $env{'form.recaptcha_challenge_field'},
                   14889:                                 $env{'form.recaptcha_response_field'},
                   14890:                               );
                   14891:     if ($captcha_result->{is_valid}) {
                   14892:         $captcha_chk = 1;
                   14893:     }
                   14894:     return $captcha_chk;
                   14895: }
                   14896: 
1.41      ng       14897: =pod
                   14898: 
                   14899: =back
                   14900: 
1.112     bowersj2 14901: =cut
1.41      ng       14902: 
1.112     bowersj2 14903: 1;
                   14904: __END__;
1.41      ng       14905: 

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