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

1.10      albertel    1: # The LearningOnline Network with CAPA
1.1       albertel    2: # a pile of common routines
1.10      albertel    3: #
1.1075.2.70! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.69 2014/03/18 01:49:39 raeburn Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.1075.2.25  raeburn    70: use Apache::lonuserutils();
1.1075.2.27  raeburn    71: use Apache::lonuserstate();
1.1075.2.69  raeburn    72: use Apache::courseclassifier();
1.479     albertel   73: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    74: use DateTime::TimeZone;
1.687     raeburn    75: use DateTime::Locale::Catalog;
1.1075.2.14  raeburn    76: use Authen::Captcha;
                     77: use Captcha::reCAPTCHA;
1.1075.2.64  raeburn    78: use Crypt::DES;
                     79: use DynaLoader; # for Crypt::DES version
1.117     www        80: 
1.517     raeburn    81: # ---------------------------------------------- Designs
                     82: use vars qw(%defaultdesign);
                     83: 
1.22      www        84: my $readit;
                     85: 
1.517     raeburn    86: 
1.157     matthew    87: ##
                     88: ## Global Variables
                     89: ##
1.46      matthew    90: 
1.643     foxr       91: 
                     92: # ----------------------------------------------- SSI with retries:
                     93: #
                     94: 
                     95: =pod
                     96: 
1.648     raeburn    97: =head1 Server Side include with retries:
1.643     foxr       98: 
                     99: =over 4
                    100: 
1.648     raeburn   101: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      102: 
                    103: Performs an ssi with some number of retries.  Retries continue either
                    104: until the result is ok or until the retry count supplied by the
                    105: caller is exhausted.  
                    106: 
                    107: Inputs:
1.648     raeburn   108: 
                    109: =over 4
                    110: 
1.643     foxr      111: resource   - Identifies the resource to insert.
1.648     raeburn   112: 
1.643     foxr      113: retries    - Count of the number of retries allowed.
1.648     raeburn   114: 
1.643     foxr      115: form       - Hash that identifies the rendering options.
                    116: 
1.648     raeburn   117: =back
                    118: 
                    119: Returns:
                    120: 
                    121: =over 4
                    122: 
1.643     foxr      123: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   124: 
1.643     foxr      125: response   - The response from the last attempt (which may or may not have been successful.
                    126: 
1.648     raeburn   127: =back
                    128: 
                    129: =back
                    130: 
1.643     foxr      131: =cut
                    132: 
                    133: sub ssi_with_retries {
                    134:     my ($resource, $retries, %form) = @_;
                    135: 
                    136: 
                    137:     my $ok = 0;			# True if we got a good response.
                    138:     my $content;
                    139:     my $response;
                    140: 
                    141:     # Try to get the ssi done. within the retries count:
                    142: 
                    143:     do {
                    144: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    145: 	$ok      = $response->is_success;
1.650     www       146:         if (!$ok) {
                    147:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    148:         }
1.643     foxr      149: 	$retries--;
                    150:     } while (!$ok && ($retries > 0));
                    151: 
                    152:     if (!$ok) {
                    153: 	$content = '';		# On error return an empty content.
                    154:     }
                    155:     return ($content, $response);
                    156: 
                    157: }
                    158: 
                    159: 
                    160: 
1.20      www       161: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  162: my %language;
1.124     www       163: my %supported_language;
1.1048    foxr      164: my %latex_language;		# For choosing hyphenation in <transl..>
                    165: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  166: my %cprtag;
1.192     taceyjo1  167: my %scprtag;
1.351     www       168: my %fe; my %fd; my %fm;
1.41      ng        169: my %category_extensions;
1.12      harris41  170: 
1.46      matthew   171: # ---------------------------------------------- Thesaurus variables
1.144     matthew   172: #
                    173: # %Keywords:
                    174: #      A hash used by &keyword to determine if a word is considered a keyword.
                    175: # $thesaurus_db_file 
                    176: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   177: 
                    178: my %Keywords;
                    179: my $thesaurus_db_file;
                    180: 
1.144     matthew   181: #
                    182: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    183: # thesaurus.tab, and filecategories.tab.
                    184: #
1.18      www       185: BEGIN {
1.46      matthew   186:     # Variable initialization
                    187:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    188:     #
1.22      www       189:     unless ($readit) {
1.12      harris41  190: # ------------------------------------------------------------------- languages
                    191:     {
1.158     raeburn   192:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    193:                                    '/language.tab';
                    194:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  195:             while (my $line = <$fh>) {
                    196:                 next if ($line=~/^\#/);
                    197:                 chomp($line);
1.1048    foxr      198:                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   199:                 $language{$key}=$val.' - '.$enc;
                    200:                 if ($sup) {
                    201:                     $supported_language{$key}=$sup;
                    202:                 }
1.1048    foxr      203: 		if ($latex) {
                    204: 		    $latex_language_bykey{$key} = $latex;
                    205: 		    $latex_language{$two} = $latex;
                    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.1075.2.31  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.1075.2.31  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]);
                    669:             if (n !== n) { // shortcut for verifying if it's NaN
                    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.1075.2.31  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.1075.2.31  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.1075.2.14  raeburn   905:             if (!field[i].disabled) {
                    906:                 field[i].checked = true;
                    907:             }
1.273     raeburn   908:         }
                    909:     } else {
1.1075.2.14  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.1075.2.32  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.1075.2.32  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.648     raeburn  1020: =item * &linked_select_forms(...)
1.36      matthew  1021: 
                   1022: linked_select_forms returns a string containing a <script></script> block
                   1023: and html for two <select> menus.  The select menus will be linked in that
                   1024: changing the value of the first menu will result in new values being placed
                   1025: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1026: order unless a defined order is provided.
1.36      matthew  1027: 
                   1028: linked_select_forms takes the following ordered inputs:
                   1029: 
                   1030: =over 4
                   1031: 
1.112     bowersj2 1032: =item * $formname, the name of the <form> tag
1.36      matthew  1033: 
1.112     bowersj2 1034: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1035: 
1.112     bowersj2 1036: =item * $firstdefault, the default value for the first menu
1.36      matthew  1037: 
1.112     bowersj2 1038: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1039: 
1.112     bowersj2 1040: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1041: 
1.112     bowersj2 1042: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1043: 
1.609     raeburn  1044: =item * $menuorder, the order of values in the first menu
                   1045: 
1.1075.2.31  raeburn  1046: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1047:         event for the first <select> tag
                   1048: 
                   1049: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1050:         event for the second <select> tag
                   1051: 
1.41      ng       1052: =back 
                   1053: 
1.36      matthew  1054: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1055: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1056: values for the first select menu.  The text that coincides with the 
1.41      ng       1057: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1058: and text for the second menu are given in the hash pointed to by 
                   1059: $menu{$choice1}->{'select2'}.  
                   1060: 
1.112     bowersj2 1061:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1062:                        default => "B3",
                   1063:                        select2 => { 
                   1064:                            B1 => "Choice B1",
                   1065:                            B2 => "Choice B2",
                   1066:                            B3 => "Choice B3",
                   1067:                            B4 => "Choice B4"
1.609     raeburn  1068:                            },
                   1069:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1070:                    },
                   1071:                A2 => { text =>"Choice A2" ,
                   1072:                        default => "C2",
                   1073:                        select2 => { 
                   1074:                            C1 => "Choice C1",
                   1075:                            C2 => "Choice C2",
                   1076:                            C3 => "Choice C3"
1.609     raeburn  1077:                            },
                   1078:                        order => ['C2','C1','C3'],
1.112     bowersj2 1079:                    },
                   1080:                A3 => { text =>"Choice A3" ,
                   1081:                        default => "D6",
                   1082:                        select2 => { 
                   1083:                            D1 => "Choice D1",
                   1084:                            D2 => "Choice D2",
                   1085:                            D3 => "Choice D3",
                   1086:                            D4 => "Choice D4",
                   1087:                            D5 => "Choice D5",
                   1088:                            D6 => "Choice D6",
                   1089:                            D7 => "Choice D7"
1.609     raeburn  1090:                            },
                   1091:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1092:                    }
                   1093:                );
1.36      matthew  1094: 
                   1095: =cut
                   1096: 
                   1097: sub linked_select_forms {
                   1098:     my ($formname,
                   1099:         $middletext,
                   1100:         $firstdefault,
                   1101:         $firstselectname,
                   1102:         $secondselectname, 
1.609     raeburn  1103:         $hashref,
                   1104:         $menuorder,
1.1075.2.31  raeburn  1105:         $onchangefirst,
                   1106:         $onchangesecond
1.36      matthew  1107:         ) = @_;
                   1108:     my $second = "document.$formname.$secondselectname";
                   1109:     my $first = "document.$formname.$firstselectname";
                   1110:     # output the javascript to do the changing
                   1111:     my $result = '';
1.776     bisitz   1112:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1113:     $result.="// <![CDATA[\n";
1.36      matthew  1114:     $result.="var select2data = new Object();\n";
                   1115:     $" = '","';
                   1116:     my $debug = '';
                   1117:     foreach my $s1 (sort(keys(%$hashref))) {
                   1118:         $result.="select2data.d_$s1 = new Object();\n";        
                   1119:         $result.="select2data.d_$s1.def = new String('".
                   1120:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1121:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1122:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1123:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1124:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1125:         }
1.36      matthew  1126:         $result.="\"@s2values\");\n";
                   1127:         $result.="select2data.d_$s1.texts = new Array(";        
                   1128:         my @s2texts;
                   1129:         foreach my $value (@s2values) {
                   1130:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1131:         }
                   1132:         $result.="\"@s2texts\");\n";
                   1133:     }
                   1134:     $"=' ';
                   1135:     $result.= <<"END";
                   1136: 
                   1137: function select1_changed() {
                   1138:     // Determine new choice
                   1139:     var newvalue = "d_" + $first.value;
                   1140:     // update select2
                   1141:     var values     = select2data[newvalue].values;
                   1142:     var texts      = select2data[newvalue].texts;
                   1143:     var select2def = select2data[newvalue].def;
                   1144:     var i;
                   1145:     // out with the old
                   1146:     for (i = 0; i < $second.options.length; i++) {
                   1147:         $second.options[i] = null;
                   1148:     }
                   1149:     // in with the nuclear
                   1150:     for (i=0;i<values.length; i++) {
                   1151:         $second.options[i] = new Option(values[i]);
1.143     matthew  1152:         $second.options[i].value = values[i];
1.36      matthew  1153:         $second.options[i].text = texts[i];
                   1154:         if (values[i] == select2def) {
                   1155:             $second.options[i].selected = true;
                   1156:         }
                   1157:     }
                   1158: }
1.824     bisitz   1159: // ]]>
1.36      matthew  1160: </script>
                   1161: END
                   1162:     # output the initial values for the selection lists
1.1075.2.31  raeburn  1163:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1164:     my @order = sort(keys(%{$hashref}));
                   1165:     if (ref($menuorder) eq 'ARRAY') {
                   1166:         @order = @{$menuorder};
                   1167:     }
                   1168:     foreach my $value (@order) {
1.36      matthew  1169:         $result.="    <option value=\"$value\" ";
1.253     albertel 1170:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1171:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1172:     }
                   1173:     $result .= "</select>\n";
                   1174:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1175:     $result .= $middletext;
1.1075.2.31  raeburn  1176:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1177:     if ($onchangesecond) {
                   1178:         $result .= ' onchange="'.$onchangesecond.'"';
                   1179:     }
                   1180:     $result .= ">\n";
1.36      matthew  1181:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1182:     
                   1183:     my @secondorder = sort(keys(%select2));
                   1184:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1185:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1186:     }
                   1187:     foreach my $value (@secondorder) {
1.36      matthew  1188:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1189:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1190:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1191:     }
                   1192:     $result .= "</select>\n";
                   1193:     #    return $debug;
                   1194:     return $result;
                   1195: }   #  end of sub linked_select_forms {
                   1196: 
1.45      matthew  1197: =pod
1.44      bowersj2 1198: 
1.973     raeburn  1199: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1200: 
1.112     bowersj2 1201: Returns a string corresponding to an HTML link to the given help
                   1202: $topic, where $topic corresponds to the name of a .tex file in
                   1203: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1204: spaces. 
                   1205: 
                   1206: $text will optionally be linked to the same topic, allowing you to
                   1207: link text in addition to the graphic. If you do not want to link
                   1208: text, but wish to specify one of the later parameters, pass an
                   1209: empty string. 
                   1210: 
                   1211: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1212: the link will not open a new window. If false, the link will open
                   1213: a new window using Javascript. (Default is false.) 
                   1214: 
                   1215: $width and $height are optional numerical parameters that will
                   1216: override the width and height of the popped up window, which may
1.973     raeburn  1217: be useful for certain help topics with big pictures included.
                   1218: 
                   1219: $imgid is the id of the img tag used for the help icon. This may be
                   1220: used in a javascript call to switch the image src.  See 
                   1221: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1222: 
                   1223: =cut
                   1224: 
                   1225: sub help_open_topic {
1.973     raeburn  1226:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1227:     $text = "" if (not defined $text);
1.44      bowersj2 1228:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1229:     $width = 500 if (not defined $width);
1.44      bowersj2 1230:     $height = 400 if (not defined $height);
                   1231:     my $filename = $topic;
                   1232:     $filename =~ s/ /_/g;
                   1233: 
1.48      bowersj2 1234:     my $template = "";
                   1235:     my $link;
1.572     banghart 1236:     
1.159     www      1237:     $topic=~s/\W/\_/g;
1.44      bowersj2 1238: 
1.572     banghart 1239:     if (!$stayOnPage) {
1.1075.2.50  raeburn  1240:         if ($env{'browser.mobile'}) {
                   1241: 	    $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
                   1242:         } else {
                   1243:             $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1244:         }
1.1037    www      1245:     } elsif ($stayOnPage eq 'popup') {
                   1246:         $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 1247:     } else {
1.48      bowersj2 1248: 	$link = "/adm/help/${filename}.hlp";
                   1249:     }
                   1250: 
                   1251:     # Add the text
1.755     neumanie 1252:     if ($text ne "") {	
1.763     bisitz   1253: 	$template.='<span class="LC_help_open_topic">'
                   1254:                   .'<a target="_top" href="'.$link.'">'
                   1255:                   .$text.'</a>';
1.48      bowersj2 1256:     }
                   1257: 
1.763     bisitz   1258:     # (Always) Add the graphic
1.179     matthew  1259:     my $title = &mt('Online Help');
1.667     raeburn  1260:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1261:     if ($imgid ne '') {
                   1262:         $imgid = ' id="'.$imgid.'"';
                   1263:     }
1.763     bisitz   1264:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1265:               .'<img src="'.$helpicon.'" border="0"'
                   1266:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1267:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1268:               .' /></a>';
                   1269:     if ($text ne "") {	
                   1270:         $template.='</span>';
                   1271:     }
1.44      bowersj2 1272:     return $template;
                   1273: 
1.106     bowersj2 1274: }
                   1275: 
                   1276: # This is a quicky function for Latex cheatsheet editing, since it 
                   1277: # appears in at least four places
                   1278: sub helpLatexCheatsheet {
1.1037    www      1279:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1280:     my $out;
1.106     bowersj2 1281:     my $addOther = '';
1.732     raeburn  1282:     if ($topic) {
1.1037    www      1283: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1284:     }
                   1285:     $out = '<span>' # Start cheatsheet
                   1286: 	  .$addOther
                   1287:           .'<span>'
1.1037    www      1288: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1289: 	  .'</span> <span>'
1.1037    www      1290: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1291: 	  .'</span>';
1.732     raeburn  1292:     unless ($not_author) {
1.763     bisitz   1293:         $out .= ' <span>'
1.1037    www      1294: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.763     bisitz   1295: 	       .'</span>';
1.732     raeburn  1296:     }
1.763     bisitz   1297:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1298:     return $out;
1.172     www      1299: }
                   1300: 
1.430     albertel 1301: sub general_help {
                   1302:     my $helptopic='Student_Intro';
                   1303:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1304: 	$helptopic='Authoring_Intro';
1.907     raeburn  1305:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1306: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1307:     } elsif ($env{'request.role'}=~/^dc/) {
                   1308:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1309:     }
                   1310:     return $helptopic;
                   1311: }
                   1312: 
                   1313: sub update_help_link {
                   1314:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1315:     my $origurl = $ENV{'REQUEST_URI'};
                   1316:     $origurl=~s|^/~|/priv/|;
                   1317:     my $timestamp = time;
                   1318:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1319:         $$datum = &escape($$datum);
                   1320:     }
                   1321: 
                   1322:     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";
                   1323:     my $output .= <<"ENDOUTPUT";
                   1324: <script type="text/javascript">
1.824     bisitz   1325: // <![CDATA[
1.430     albertel 1326: banner_link = '$banner_link';
1.824     bisitz   1327: // ]]>
1.430     albertel 1328: </script>
                   1329: ENDOUTPUT
                   1330:     return $output;
                   1331: }
                   1332: 
                   1333: # now just updates the help link and generates a blue icon
1.193     raeburn  1334: sub help_open_menu {
1.430     albertel 1335:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1336: 	= @_;    
1.949     droeschl 1337:     $stayOnPage = 1;
1.430     albertel 1338:     my $output;
                   1339:     if ($component_help) {
                   1340: 	if (!$text) {
                   1341: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1342: 				       $width,$height);
                   1343: 	} else {
                   1344: 	    my $help_text;
                   1345: 	    $help_text=&unescape($topic);
                   1346: 	    $output='<table><tr><td>'.
                   1347: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1348: 				 $width,$height).'</td></tr></table>';
                   1349: 	}
                   1350:     }
                   1351:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1352:     return $output.$banner_link;
                   1353: }
                   1354: 
                   1355: sub top_nav_help {
                   1356:     my ($text) = @_;
1.436     albertel 1357:     $text = &mt($text);
1.1075.2.60  raeburn  1358:     my $stay_on_page;
                   1359:     unless ($env{'environment.remote'} eq 'on') {
                   1360:         $stay_on_page = 1;
                   1361:     }
1.1075.2.61  raeburn  1362:     my ($link,$banner_link);
                   1363:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1364:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1365: 	                         : "javascript:helpMenu('open')";
                   1366:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1367:     }
1.201     raeburn  1368:     my $title = &mt('Get help');
1.1075.2.61  raeburn  1369:     if ($link) {
                   1370:         return <<"END";
1.436     albertel 1371: $banner_link
1.1075.2.56  raeburn  1372: <a href="$link" title="$title">$text</a>
1.436     albertel 1373: END
1.1075.2.61  raeburn  1374:     } else {
                   1375:         return '&nbsp;'.$text.'&nbsp;';
                   1376:     }
1.436     albertel 1377: }
                   1378: 
                   1379: sub help_menu_js {
1.1075.2.52  raeburn  1380:     my ($httphost) = @_;
1.949     droeschl 1381:     my $stayOnPage = 1;
1.436     albertel 1382:     my $width = 620;
                   1383:     my $height = 600;
1.430     albertel 1384:     my $helptopic=&general_help();
1.1075.2.52  raeburn  1385:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1386:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1387:     my $start_page =
                   1388:         &Apache::loncommon::start_page('Help Menu', undef,
                   1389: 				       {'frameset'    => 1,
                   1390: 					'js_ready'    => 1,
1.1075.2.52  raeburn  1391:                                         'use_absolute' => $httphost, 
1.331     albertel 1392: 					'add_entries' => {
                   1393: 					    'border' => '0',
1.579     raeburn  1394: 					    'rows'   => "110,*",},});
1.331     albertel 1395:     my $end_page =
                   1396:         &Apache::loncommon::end_page({'frameset' => 1,
                   1397: 				      'js_ready' => 1,});
                   1398: 
1.436     albertel 1399:     my $template .= <<"ENDTEMPLATE";
                   1400: <script type="text/javascript">
1.877     bisitz   1401: // <![CDATA[
1.253     albertel 1402: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1403: var banner_link = '';
1.243     raeburn  1404: function helpMenu(target) {
                   1405:     var caller = this;
                   1406:     if (target == 'open') {
                   1407:         var newWindow = null;
                   1408:         try {
1.262     albertel 1409:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1410:         }
                   1411:         catch(error) {
                   1412:             writeHelp(caller);
                   1413:             return;
                   1414:         }
                   1415:         if (newWindow) {
                   1416:             caller = newWindow;
                   1417:         }
1.193     raeburn  1418:     }
1.243     raeburn  1419:     writeHelp(caller);
                   1420:     return;
                   1421: }
                   1422: function writeHelp(caller) {
1.1075.2.61  raeburn  1423:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1424:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1425:     caller.document.close();
                   1426:     caller.focus();
1.193     raeburn  1427: }
1.877     bisitz   1428: // END LON-CAPA Internal -->
1.253     albertel 1429: // ]]>
1.436     albertel 1430: </script>
1.193     raeburn  1431: ENDTEMPLATE
                   1432:     return $template;
                   1433: }
                   1434: 
1.172     www      1435: sub help_open_bug {
                   1436:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1437:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1438:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1439:     $text = "" if (not defined $text);
                   1440: 	$stayOnPage=1;
1.184     albertel 1441:     $width = 600 if (not defined $width);
                   1442:     $height = 600 if (not defined $height);
1.172     www      1443: 
                   1444:     $topic=~s/\W+/\+/g;
                   1445:     my $link='';
                   1446:     my $template='';
1.379     albertel 1447:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1448: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1449:     if (!$stayOnPage)
                   1450:     {
                   1451: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1452:     }
                   1453:     else
                   1454:     {
                   1455: 	$link = $url;
                   1456:     }
                   1457:     # Add the text
                   1458:     if ($text ne "")
                   1459:     {
                   1460: 	$template .= 
                   1461:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1462:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1463:     }
                   1464: 
                   1465:     # Add the graphic
1.179     matthew  1466:     my $title = &mt('Report a Bug');
1.215     albertel 1467:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1468:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1469:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1470: ENDTEMPLATE
                   1471:     if ($text ne '') { $template.='</td></tr></table>' };
                   1472:     return $template;
                   1473: 
                   1474: }
                   1475: 
                   1476: sub help_open_faq {
                   1477:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1478:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1479:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1480:     $text = "" if (not defined $text);
                   1481: 	$stayOnPage=1;
                   1482:     $width = 350 if (not defined $width);
                   1483:     $height = 400 if (not defined $height);
                   1484: 
                   1485:     $topic=~s/\W+/\+/g;
                   1486:     my $link='';
                   1487:     my $template='';
                   1488:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1489:     if (!$stayOnPage)
                   1490:     {
                   1491: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1492:     }
                   1493:     else
                   1494:     {
                   1495: 	$link = $url;
                   1496:     }
                   1497: 
                   1498:     # Add the text
                   1499:     if ($text ne "")
                   1500:     {
                   1501: 	$template .= 
1.173     www      1502:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1503:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1504:     }
                   1505: 
                   1506:     # Add the graphic
1.179     matthew  1507:     my $title = &mt('View the FAQ');
1.215     albertel 1508:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1509:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1510:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1511: ENDTEMPLATE
                   1512:     if ($text ne '') { $template.='</td></tr></table>' };
                   1513:     return $template;
                   1514: 
1.44      bowersj2 1515: }
1.37      matthew  1516: 
1.180     matthew  1517: ###############################################################
                   1518: ###############################################################
                   1519: 
1.45      matthew  1520: =pod
                   1521: 
1.648     raeburn  1522: =item * &change_content_javascript():
1.256     matthew  1523: 
                   1524: This and the next function allow you to create small sections of an
                   1525: otherwise static HTML page that you can update on the fly with
                   1526: Javascript, even in Netscape 4.
                   1527: 
                   1528: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1529: must be written to the HTML page once. It will prove the Javascript
                   1530: function "change(name, content)". Calling the change function with the
                   1531: name of the section 
                   1532: you want to update, matching the name passed to C<changable_area>, and
                   1533: the new content you want to put in there, will put the content into
                   1534: that area.
                   1535: 
                   1536: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1537: to contain room for the original contents. You need to "make space"
                   1538: for whatever changes you wish to make, and be B<sure> to check your
                   1539: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1540: it's adequate for updating a one-line status display, but little more.
                   1541: This script will set the space to 100% width, so you only need to
                   1542: worry about height in Netscape 4.
                   1543: 
                   1544: Modern browsers are much less limiting, and if you can commit to the
                   1545: user not using Netscape 4, this feature may be used freely with
                   1546: pretty much any HTML.
                   1547: 
                   1548: =cut
                   1549: 
                   1550: sub change_content_javascript {
                   1551:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1552:     if ($env{'browser.type'} eq 'netscape' &&
                   1553: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1554: 	return (<<NETSCAPE4);
                   1555: 	function change(name, content) {
                   1556: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1557: 	    doc.open();
                   1558: 	    doc.write(content);
                   1559: 	    doc.close();
                   1560: 	}
                   1561: NETSCAPE4
                   1562:     } else {
                   1563: 	# Otherwise, we need to use semi-standards-compliant code
                   1564: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1565: 	# is really scary, and every useful browser supports it
                   1566: 	return (<<DOMBASED);
                   1567: 	function change(name, content) {
                   1568: 	    element = document.getElementById(name);
                   1569: 	    element.innerHTML = content;
                   1570: 	}
                   1571: DOMBASED
                   1572:     }
                   1573: }
                   1574: 
                   1575: =pod
                   1576: 
1.648     raeburn  1577: =item * &changable_area($name,$origContent):
1.256     matthew  1578: 
                   1579: This provides a "changable area" that can be modified on the fly via
                   1580: the Javascript code provided in C<change_content_javascript>. $name is
                   1581: the name you will use to reference the area later; do not repeat the
                   1582: same name on a given HTML page more then once. $origContent is what
                   1583: the area will originally contain, which can be left blank.
                   1584: 
                   1585: =cut
                   1586: 
                   1587: sub changable_area {
                   1588:     my ($name, $origContent) = @_;
                   1589: 
1.258     albertel 1590:     if ($env{'browser.type'} eq 'netscape' &&
                   1591: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1592: 	# If this is netscape 4, we need to use the Layer tag
                   1593: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1594:     } else {
                   1595: 	return "<span id='$name'>$origContent</span>";
                   1596:     }
                   1597: }
                   1598: 
                   1599: =pod
                   1600: 
1.648     raeburn  1601: =item * &viewport_geometry_js 
1.590     raeburn  1602: 
                   1603: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1604: 
                   1605: =cut
                   1606: 
                   1607: 
                   1608: sub viewport_geometry_js { 
                   1609:     return <<"GEOMETRY";
                   1610: var Geometry = {};
                   1611: function init_geometry() {
                   1612:     if (Geometry.init) { return };
                   1613:     Geometry.init=1;
                   1614:     if (window.innerHeight) {
                   1615:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1616:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1617:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1618:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1619:     }
                   1620:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1621:         Geometry.getViewportHeight =
                   1622:             function() { return document.documentElement.clientHeight; };
                   1623:         Geometry.getViewportWidth =
                   1624:             function() { return document.documentElement.clientWidth; };
                   1625: 
                   1626:         Geometry.getHorizontalScroll =
                   1627:             function() { return document.documentElement.scrollLeft; };
                   1628:         Geometry.getVerticalScroll =
                   1629:             function() { return document.documentElement.scrollTop; };
                   1630:     }
                   1631:     else if (document.body.clientHeight) {
                   1632:         Geometry.getViewportHeight =
                   1633:             function() { return document.body.clientHeight; };
                   1634:         Geometry.getViewportWidth =
                   1635:             function() { return document.body.clientWidth; };
                   1636:         Geometry.getHorizontalScroll =
                   1637:             function() { return document.body.scrollLeft; };
                   1638:         Geometry.getVerticalScroll =
                   1639:             function() { return document.body.scrollTop; };
                   1640:     }
                   1641: }
                   1642: 
                   1643: GEOMETRY
                   1644: }
                   1645: 
                   1646: =pod
                   1647: 
1.648     raeburn  1648: =item * &viewport_size_js()
1.590     raeburn  1649: 
                   1650: 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. 
                   1651: 
                   1652: =cut
                   1653: 
                   1654: sub viewport_size_js {
                   1655:     my $geometry = &viewport_geometry_js();
                   1656:     return <<"DIMS";
                   1657: 
                   1658: $geometry
                   1659: 
                   1660: function getViewportDims(width,height) {
                   1661:     init_geometry();
                   1662:     width.value = Geometry.getViewportWidth();
                   1663:     height.value = Geometry.getViewportHeight();
                   1664:     return;
                   1665: }
                   1666: 
                   1667: DIMS
                   1668: }
                   1669: 
                   1670: =pod
                   1671: 
1.648     raeburn  1672: =item * &resize_textarea_js()
1.565     albertel 1673: 
                   1674: emits the needed javascript to resize a textarea to be as big as possible
                   1675: 
                   1676: creates a function resize_textrea that takes two IDs first should be
                   1677: the id of the element to resize, second should be the id of a div that
                   1678: surrounds everything that comes after the textarea, this routine needs
                   1679: to be attached to the <body> for the onload and onresize events.
                   1680: 
1.648     raeburn  1681: =back
1.565     albertel 1682: 
                   1683: =cut
                   1684: 
                   1685: sub resize_textarea_js {
1.590     raeburn  1686:     my $geometry = &viewport_geometry_js();
1.565     albertel 1687:     return <<"RESIZE";
                   1688:     <script type="text/javascript">
1.824     bisitz   1689: // <![CDATA[
1.590     raeburn  1690: $geometry
1.565     albertel 1691: 
1.588     albertel 1692: function getX(element) {
                   1693:     var x = 0;
                   1694:     while (element) {
                   1695: 	x += element.offsetLeft;
                   1696: 	element = element.offsetParent;
                   1697:     }
                   1698:     return x;
                   1699: }
                   1700: function getY(element) {
                   1701:     var y = 0;
                   1702:     while (element) {
                   1703: 	y += element.offsetTop;
                   1704: 	element = element.offsetParent;
                   1705:     }
                   1706:     return y;
                   1707: }
                   1708: 
                   1709: 
1.565     albertel 1710: function resize_textarea(textarea_id,bottom_id) {
                   1711:     init_geometry();
                   1712:     var textarea        = document.getElementById(textarea_id);
                   1713:     //alert(textarea);
                   1714: 
1.588     albertel 1715:     var textarea_top    = getY(textarea);
1.565     albertel 1716:     var textarea_height = textarea.offsetHeight;
                   1717:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1718:     var bottom_top      = getY(bottom);
1.565     albertel 1719:     var bottom_height   = bottom.offsetHeight;
                   1720:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1721:     var fudge           = 23;
1.565     albertel 1722:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1723:     if (new_height < 300) {
                   1724: 	new_height = 300;
                   1725:     }
                   1726:     textarea.style.height=new_height+'px';
                   1727: }
1.824     bisitz   1728: // ]]>
1.565     albertel 1729: </script>
                   1730: RESIZE
                   1731: 
                   1732: }
                   1733: 
                   1734: =pod
                   1735: 
1.256     matthew  1736: =head1 Excel and CSV file utility routines
                   1737: 
                   1738: =cut
                   1739: 
                   1740: ###############################################################
                   1741: ###############################################################
                   1742: 
                   1743: =pod
                   1744: 
1.1075.2.56  raeburn  1745: =over 4
                   1746: 
1.648     raeburn  1747: =item * &csv_translate($text) 
1.37      matthew  1748: 
1.185     www      1749: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1750: format.
                   1751: 
                   1752: =cut
                   1753: 
1.180     matthew  1754: ###############################################################
                   1755: ###############################################################
1.37      matthew  1756: sub csv_translate {
                   1757:     my $text = shift;
                   1758:     $text =~ s/\"/\"\"/g;
1.209     albertel 1759:     $text =~ s/\n/ /g;
1.37      matthew  1760:     return $text;
                   1761: }
1.180     matthew  1762: 
                   1763: ###############################################################
                   1764: ###############################################################
                   1765: 
                   1766: =pod
                   1767: 
1.648     raeburn  1768: =item * &define_excel_formats()
1.180     matthew  1769: 
                   1770: Define some commonly used Excel cell formats.
                   1771: 
                   1772: Currently supported formats:
                   1773: 
                   1774: =over 4
                   1775: 
                   1776: =item header
                   1777: 
                   1778: =item bold
                   1779: 
                   1780: =item h1
                   1781: 
                   1782: =item h2
                   1783: 
                   1784: =item h3
                   1785: 
1.256     matthew  1786: =item h4
                   1787: 
                   1788: =item i
                   1789: 
1.180     matthew  1790: =item date
                   1791: 
                   1792: =back
                   1793: 
                   1794: Inputs: $workbook
                   1795: 
                   1796: Returns: $format, a hash reference.
                   1797: 
1.1057    foxr     1798: 
1.180     matthew  1799: =cut
                   1800: 
                   1801: ###############################################################
                   1802: ###############################################################
                   1803: sub define_excel_formats {
                   1804:     my ($workbook) = @_;
                   1805:     my $format;
                   1806:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1807:                                                 bottom    => 1,
                   1808:                                                 align     => 'center');
                   1809:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1810:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1811:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1812:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1813:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1814:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1815:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1816:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1817:     return $format;
                   1818: }
                   1819: 
                   1820: ###############################################################
                   1821: ###############################################################
1.113     bowersj2 1822: 
                   1823: =pod
                   1824: 
1.648     raeburn  1825: =item * &create_workbook()
1.255     matthew  1826: 
                   1827: Create an Excel worksheet.  If it fails, output message on the
                   1828: request object and return undefs.
                   1829: 
                   1830: Inputs: Apache request object
                   1831: 
                   1832: Returns (undef) on failure, 
                   1833:     Excel worksheet object, scalar with filename, and formats 
                   1834:     from &Apache::loncommon::define_excel_formats on success
                   1835: 
                   1836: =cut
                   1837: 
                   1838: ###############################################################
                   1839: ###############################################################
                   1840: sub create_workbook {
                   1841:     my ($r) = @_;
                   1842:         #
                   1843:     # Create the excel spreadsheet
                   1844:     my $filename = '/prtspool/'.
1.258     albertel 1845:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1846:         time.'_'.rand(1000000000).'.xls';
                   1847:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1848:     if (! defined($workbook)) {
                   1849:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1850:         $r->print(
                   1851:             '<p class="LC_error">'
                   1852:            .&mt('Problems occurred in creating the new Excel file.')
                   1853:            .' '.&mt('This error has been logged.')
                   1854:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1855:            .'</p>'
                   1856:         );
1.255     matthew  1857:         return (undef);
                   1858:     }
                   1859:     #
1.1014    foxr     1860:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1861:     #
                   1862:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1863:     return ($workbook,$filename,$format);
                   1864: }
                   1865: 
                   1866: ###############################################################
                   1867: ###############################################################
                   1868: 
                   1869: =pod
                   1870: 
1.648     raeburn  1871: =item * &create_text_file()
1.113     bowersj2 1872: 
1.542     raeburn  1873: Create a file to write to and eventually make available to the user.
1.256     matthew  1874: If file creation fails, outputs an error message on the request object and 
                   1875: return undefs.
1.113     bowersj2 1876: 
1.256     matthew  1877: Inputs: Apache request object, and file suffix
1.113     bowersj2 1878: 
1.256     matthew  1879: Returns (undef) on failure, 
                   1880:     Filehandle and filename on success.
1.113     bowersj2 1881: 
                   1882: =cut
                   1883: 
1.256     matthew  1884: ###############################################################
                   1885: ###############################################################
                   1886: sub create_text_file {
                   1887:     my ($r,$suffix) = @_;
                   1888:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1889:     my $fh;
                   1890:     my $filename = '/prtspool/'.
1.258     albertel 1891:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1892:         time.'_'.rand(1000000000).'.'.$suffix;
                   1893:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1894:     if (! defined($fh)) {
                   1895:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1896:         $r->print(
                   1897:             '<p class="LC_error">'
                   1898:            .&mt('Problems occurred in creating the output file.')
                   1899:            .' '.&mt('This error has been logged.')
                   1900:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1901:            .'</p>'
                   1902:         );
1.113     bowersj2 1903:     }
1.256     matthew  1904:     return ($fh,$filename)
1.113     bowersj2 1905: }
                   1906: 
                   1907: 
1.256     matthew  1908: =pod 
1.113     bowersj2 1909: 
                   1910: =back
                   1911: 
                   1912: =cut
1.37      matthew  1913: 
                   1914: ###############################################################
1.33      matthew  1915: ##        Home server <option> list generating code          ##
                   1916: ###############################################################
1.35      matthew  1917: 
1.169     www      1918: # ------------------------------------------
                   1919: 
                   1920: sub domain_select {
                   1921:     my ($name,$value,$multiple)=@_;
                   1922:     my %domains=map { 
1.514     albertel 1923: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1924:     } &Apache::lonnet::all_domains();
1.169     www      1925:     if ($multiple) {
                   1926: 	$domains{''}=&mt('Any domain');
1.550     albertel 1927: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1928: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1929:     } else {
1.550     albertel 1930: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1931: 	return &select_form($name,$value,\%domains);
1.169     www      1932:     }
                   1933: }
                   1934: 
1.282     albertel 1935: #-------------------------------------------
                   1936: 
                   1937: =pod
                   1938: 
1.519     raeburn  1939: =head1 Routines for form select boxes
                   1940: 
                   1941: =over 4
                   1942: 
1.648     raeburn  1943: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1944: 
                   1945: Returns a string containing a <select> element int multiple mode
                   1946: 
                   1947: 
                   1948: Args:
                   1949:   $name - name of the <select> element
1.506     raeburn  1950:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1951:   $size - number of rows long the select element is
1.283     albertel 1952:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1953:           (shown text should already have been &mt())
1.506     raeburn  1954:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1955: 
1.282     albertel 1956: =cut
                   1957: 
                   1958: #-------------------------------------------
1.169     www      1959: sub multiple_select_form {
1.284     albertel 1960:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1961:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1962:     my $output='';
1.191     matthew  1963:     if (! defined($size)) {
                   1964:         $size = 4;
1.283     albertel 1965:         if (scalar(keys(%$hash))<4) {
                   1966:             $size = scalar(keys(%$hash));
1.191     matthew  1967:         }
                   1968:     }
1.734     bisitz   1969:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1970:     my @order;
1.506     raeburn  1971:     if (ref($order) eq 'ARRAY')  {
                   1972:         @order = @{$order};
                   1973:     } else {
                   1974:         @order = sort(keys(%$hash));
1.501     banghart 1975:     }
                   1976:     if (exists($$hash{'select_form_order'})) {
                   1977:         @order = @{$$hash{'select_form_order'}};
                   1978:     }
                   1979:         
1.284     albertel 1980:     foreach my $key (@order) {
1.356     albertel 1981:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1982:         $output.='selected="selected" ' if ($selected{$key});
                   1983:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1984:     }
                   1985:     $output.="</select>\n";
                   1986:     return $output;
                   1987: }
                   1988: 
1.88      www      1989: #-------------------------------------------
                   1990: 
                   1991: =pod
                   1992: 
1.970     raeburn  1993: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1994: 
                   1995: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1996: allow a user to select options from a ref to a hash containing:
                   1997: option_name => displayed text. An optional $onchange can include
                   1998: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   1999: 
1.88      www      2000: See lonrights.pm for an example invocation and use.
                   2001: 
                   2002: =cut
                   2003: 
                   2004: #-------------------------------------------
                   2005: sub select_form {
1.970     raeburn  2006:     my ($def,$name,$hashref,$onchange) = @_;
                   2007:     return unless (ref($hashref) eq 'HASH');
                   2008:     if ($onchange) {
                   2009:         $onchange = ' onchange="'.$onchange.'"';
                   2010:     }
                   2011:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 2012:     my @keys;
1.970     raeburn  2013:     if (exists($hashref->{'select_form_order'})) {
                   2014: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2015:     } else {
1.970     raeburn  2016: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2017:     }
1.356     albertel 2018:     foreach my $key (@keys) {
                   2019:         $selectform.=
                   2020: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2021:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2022:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2023:     }
                   2024:     $selectform.="</select>";
                   2025:     return $selectform;
                   2026: }
                   2027: 
1.475     www      2028: # For display filters
                   2029: 
                   2030: sub display_filter {
1.1074    raeburn  2031:     my ($context) = @_;
1.475     www      2032:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2033:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2034:     my $phraseinput = 'hidden';
                   2035:     my $includeinput = 'hidden';
                   2036:     my ($checked,$includetypestext);
                   2037:     if ($env{'form.displayfilter'} eq 'containing') {
                   2038:         $phraseinput = 'text'; 
                   2039:         if ($context eq 'parmslog') {
                   2040:             $includeinput = 'checkbox';
                   2041:             if ($env{'form.includetypes'}) {
                   2042:                 $checked = ' checked="checked"';
                   2043:             }
                   2044:             $includetypestext = &mt('Include parameter types');
                   2045:         }
                   2046:     } else {
                   2047:         $includetypestext = '&nbsp;';
                   2048:     }
                   2049:     my ($additional,$secondid,$thirdid);
                   2050:     if ($context eq 'parmslog') {
                   2051:         $additional = 
                   2052:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2053:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2054:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2055:             '</label>';
                   2056:         $secondid = 'includetypes';
                   2057:         $thirdid = 'includetypestext';
                   2058:     }
                   2059:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2060:                                                     '$secondid','$thirdid')";
                   2061:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2062: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2063: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2064: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2065:            &mt('Filter: [_1]',
1.477     www      2066: 	   &select_form($env{'form.displayfilter'},
                   2067: 			'displayfilter',
1.970     raeburn  2068: 			{'currentfolder' => 'Current folder/page',
1.477     www      2069: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2070: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2071: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2072:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2073:                          '" />'.$additional;
                   2074: }
                   2075: 
                   2076: sub display_filter_js {
                   2077:     my $includetext = &mt('Include parameter types');
                   2078:     return <<"ENDJS";
                   2079:   
                   2080: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2081:     var firstType = 'hidden';
                   2082:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2083:         firstType = 'text';
                   2084:     }
                   2085:     firstObject = document.getElementById(firstid);
                   2086:     if (typeof(firstObject) == 'object') {
                   2087:         if (firstObject.type != firstType) {
                   2088:             changeInputType(firstObject,firstType);
                   2089:         }
                   2090:     }
                   2091:     if (context == 'parmslog') {
                   2092:         var secondType = 'hidden';
                   2093:         if (firstType == 'text') {
                   2094:             secondType = 'checkbox';
                   2095:         }
                   2096:         secondObject = document.getElementById(secondid);  
                   2097:         if (typeof(secondObject) == 'object') {
                   2098:             if (secondObject.type != secondType) {
                   2099:                 changeInputType(secondObject,secondType);
                   2100:             }
                   2101:         }
                   2102:         var textItem = document.getElementById(thirdid);
                   2103:         var currtext = textItem.innerHTML;
                   2104:         var newtext;
                   2105:         if (firstType == 'text') {
                   2106:             newtext = '$includetext';
                   2107:         } else {
                   2108:             newtext = '&nbsp;';
                   2109:         }
                   2110:         if (currtext != newtext) {
                   2111:             textItem.innerHTML = newtext;
                   2112:         }
                   2113:     }
                   2114:     return;
                   2115: }
                   2116: 
                   2117: function changeInputType(oldObject,newType) {
                   2118:     var newObject = document.createElement('input');
                   2119:     newObject.type = newType;
                   2120:     if (oldObject.size) {
                   2121:         newObject.size = oldObject.size;
                   2122:     }
                   2123:     if (oldObject.value) {
                   2124:         newObject.value = oldObject.value;
                   2125:     }
                   2126:     if (oldObject.name) {
                   2127:         newObject.name = oldObject.name;
                   2128:     }
                   2129:     if (oldObject.id) {
                   2130:         newObject.id = oldObject.id;
                   2131:     }
                   2132:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2133:     return;
                   2134: }
                   2135: 
                   2136: ENDJS
1.475     www      2137: }
                   2138: 
1.167     www      2139: sub gradeleveldescription {
                   2140:     my $gradelevel=shift;
                   2141:     my %gradelevels=(0 => 'Not specified',
                   2142: 		     1 => 'Grade 1',
                   2143: 		     2 => 'Grade 2',
                   2144: 		     3 => 'Grade 3',
                   2145: 		     4 => 'Grade 4',
                   2146: 		     5 => 'Grade 5',
                   2147: 		     6 => 'Grade 6',
                   2148: 		     7 => 'Grade 7',
                   2149: 		     8 => 'Grade 8',
                   2150: 		     9 => 'Grade 9',
                   2151: 		     10 => 'Grade 10',
                   2152: 		     11 => 'Grade 11',
                   2153: 		     12 => 'Grade 12',
                   2154: 		     13 => 'Grade 13',
                   2155: 		     14 => '100 Level',
                   2156: 		     15 => '200 Level',
                   2157: 		     16 => '300 Level',
                   2158: 		     17 => '400 Level',
                   2159: 		     18 => 'Graduate Level');
                   2160:     return &mt($gradelevels{$gradelevel});
                   2161: }
                   2162: 
1.163     www      2163: sub select_level_form {
                   2164:     my ($deflevel,$name)=@_;
                   2165:     unless ($deflevel) { $deflevel=0; }
1.167     www      2166:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2167:     for (my $i=0; $i<=18; $i++) {
                   2168:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2169:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2170:                 ">".&gradeleveldescription($i)."</option>\n";
                   2171:     }
                   2172:     $selectform.="</select>";
                   2173:     return $selectform;
1.163     www      2174: }
1.167     www      2175: 
1.35      matthew  2176: #-------------------------------------------
                   2177: 
1.45      matthew  2178: =pod
                   2179: 
1.1075.2.42  raeburn  2180: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2181: 
                   2182: Returns a string containing a <select name='$name' size='1'> form to 
                   2183: allow a user to select the domain to preform an operation in.  
                   2184: See loncreateuser.pm for an example invocation and use.
                   2185: 
1.90      www      2186: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2187: selected");
                   2188: 
1.743     raeburn  2189: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2190: 
1.910     raeburn  2191: 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.
                   2192: 
1.1075.2.36  raeburn  2193: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2194: 
                   2195: The optional $excdoms is a reference to an array of domains which will be excluded from the available options. 
1.563     raeburn  2196: 
1.35      matthew  2197: =cut
                   2198: 
                   2199: #-------------------------------------------
1.34      matthew  2200: sub select_dom_form {
1.1075.2.36  raeburn  2201:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2202:     if ($onchange) {
1.874     raeburn  2203:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2204:     }
1.1075.2.36  raeburn  2205:     my (@domains,%exclude);
1.910     raeburn  2206:     if (ref($incdoms) eq 'ARRAY') {
                   2207:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2208:     } else {
                   2209:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2210:     }
1.90      www      2211:     if ($includeempty) { @domains=('',@domains); }
1.1075.2.36  raeburn  2212:     if (ref($excdoms) eq 'ARRAY') {
                   2213:         map { $exclude{$_} = 1; } @{$excdoms};
                   2214:     }
1.743     raeburn  2215:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2216:     foreach my $dom (@domains) {
1.1075.2.36  raeburn  2217:         next if ($exclude{$dom});
1.356     albertel 2218:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2219:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2220:         if ($showdomdesc) {
                   2221:             if ($dom ne '') {
                   2222:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2223:                 if ($domdesc ne '') {
                   2224:                     $selectdomain .= ' ('.$domdesc.')';
                   2225:                 }
                   2226:             } 
                   2227:         }
                   2228:         $selectdomain .= "</option>\n";
1.34      matthew  2229:     }
                   2230:     $selectdomain.="</select>";
                   2231:     return $selectdomain;
                   2232: }
                   2233: 
1.35      matthew  2234: #-------------------------------------------
                   2235: 
1.45      matthew  2236: =pod
                   2237: 
1.648     raeburn  2238: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2239: 
1.586     raeburn  2240: input: 4 arguments (two required, two optional) - 
                   2241:     $domain - domain of new user
                   2242:     $name - name of form element
                   2243:     $default - Value of 'default' causes a default item to be first 
                   2244:                             option, and selected by default. 
                   2245:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2246:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2247: output: returns 2 items: 
1.586     raeburn  2248: (a) form element which contains either:
                   2249:    (i) <select name="$name">
                   2250:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2251:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2252:        </select>
                   2253:        form item if there are multiple library servers in $domain, or
                   2254:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2255:        if there is only one library server in $domain.
                   2256: 
                   2257: (b) number of library servers found.
                   2258: 
                   2259: See loncreateuser.pm for example of use.
1.35      matthew  2260: 
                   2261: =cut
                   2262: 
                   2263: #-------------------------------------------
1.586     raeburn  2264: sub home_server_form_item {
                   2265:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2266:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2267:     my $result;
                   2268:     my $numlib = keys(%servers);
                   2269:     if ($numlib > 1) {
                   2270:         $result .= '<select name="'.$name.'" />'."\n";
                   2271:         if ($default) {
1.804     bisitz   2272:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2273:                        '</option>'."\n";
                   2274:         }
                   2275:         foreach my $hostid (sort(keys(%servers))) {
                   2276:             $result.= '<option value="'.$hostid.'">'.
                   2277: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2278:         }
                   2279:         $result .= '</select>'."\n";
                   2280:     } elsif ($numlib == 1) {
                   2281:         my $hostid;
                   2282:         foreach my $item (keys(%servers)) {
                   2283:             $hostid = $item;
                   2284:         }
                   2285:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2286:                    $hostid.'" />';
                   2287:                    if (!$hide) {
                   2288:                        $result .= $hostid.' '.$servers{$hostid};
                   2289:                    }
                   2290:                    $result .= "\n";
                   2291:     } elsif ($default) {
                   2292:         $result .= '<input type="hidden" name="'.$name.
                   2293:                    '" value="default" />';
                   2294:                    if (!$hide) {
                   2295:                        $result .= &mt('default');
                   2296:                    }
                   2297:                    $result .= "\n";
1.33      matthew  2298:     }
1.586     raeburn  2299:     return ($result,$numlib);
1.33      matthew  2300: }
1.112     bowersj2 2301: 
                   2302: =pod
                   2303: 
1.534     albertel 2304: =back 
                   2305: 
1.112     bowersj2 2306: =cut
1.87      matthew  2307: 
                   2308: ###############################################################
1.112     bowersj2 2309: ##                  Decoding User Agent                      ##
1.87      matthew  2310: ###############################################################
                   2311: 
                   2312: =pod
                   2313: 
1.112     bowersj2 2314: =head1 Decoding the User Agent
                   2315: 
                   2316: =over 4
                   2317: 
                   2318: =item * &decode_user_agent()
1.87      matthew  2319: 
                   2320: Inputs: $r
                   2321: 
                   2322: Outputs:
                   2323: 
                   2324: =over 4
                   2325: 
1.112     bowersj2 2326: =item * $httpbrowser
1.87      matthew  2327: 
1.112     bowersj2 2328: =item * $clientbrowser
1.87      matthew  2329: 
1.112     bowersj2 2330: =item * $clientversion
1.87      matthew  2331: 
1.112     bowersj2 2332: =item * $clientmathml
1.87      matthew  2333: 
1.112     bowersj2 2334: =item * $clientunicode
1.87      matthew  2335: 
1.112     bowersj2 2336: =item * $clientos
1.87      matthew  2337: 
1.1075.2.42  raeburn  2338: =item * $clientmobile
                   2339: 
                   2340: =item * $clientinfo
                   2341: 
1.87      matthew  2342: =back
                   2343: 
1.157     matthew  2344: =back 
                   2345: 
1.87      matthew  2346: =cut
                   2347: 
                   2348: ###############################################################
                   2349: ###############################################################
                   2350: sub decode_user_agent {
1.247     albertel 2351:     my ($r)=@_;
1.87      matthew  2352:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2353:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2354:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2355:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2356:     my $clientbrowser='unknown';
                   2357:     my $clientversion='0';
                   2358:     my $clientmathml='';
                   2359:     my $clientunicode='0';
1.1075.2.42  raeburn  2360:     my $clientmobile=0;
1.87      matthew  2361:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2362:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2363: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2364: 	    $clientbrowser=$bname;
                   2365:             $httpbrowser=~/$vreg/i;
                   2366: 	    $clientversion=$1;
                   2367:             $clientmathml=($clientversion>=$minv);
                   2368:             $clientunicode=($clientversion>=$univ);
                   2369: 	}
                   2370:     }
                   2371:     my $clientos='unknown';
1.1075.2.42  raeburn  2372:     my $clientinfo;
1.87      matthew  2373:     if (($httpbrowser=~/linux/i) ||
                   2374:         ($httpbrowser=~/unix/i) ||
                   2375:         ($httpbrowser=~/ux/i) ||
                   2376:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2377:     if (($httpbrowser=~/vax/i) ||
                   2378:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2379:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2380:     if (($httpbrowser=~/mac/i) ||
                   2381:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2382:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2383:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42  raeburn  2384:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2385:         $clientmobile=lc($1);
                   2386:     }
                   2387:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2388:         $clientinfo = 'firefox-'.$1;
                   2389:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2390:         $clientinfo = 'chromeframe-'.$1;
                   2391:     }
1.87      matthew  2392:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.42  raeburn  2393:             $clientunicode,$clientos,$clientmobile,$clientinfo);
1.87      matthew  2394: }
                   2395: 
1.32      matthew  2396: ###############################################################
                   2397: ##    Authentication changing form generation subroutines    ##
                   2398: ###############################################################
                   2399: ##
                   2400: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2401: ## hash, and have reasonable default values.
                   2402: ##
                   2403: ##    formname = the name given in the <form> tag.
1.35      matthew  2404: #-------------------------------------------
                   2405: 
1.45      matthew  2406: =pod
                   2407: 
1.112     bowersj2 2408: =head1 Authentication Routines
                   2409: 
                   2410: =over 4
                   2411: 
1.648     raeburn  2412: =item * &authform_xxxxxx()
1.35      matthew  2413: 
                   2414: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2415: handle some of the conveniences required for authentication forms.  
                   2416: This is not an optimal method, but it works.  
                   2417: 
                   2418: =over 4
                   2419: 
1.112     bowersj2 2420: =item * authform_header
1.35      matthew  2421: 
1.112     bowersj2 2422: =item * authform_authorwarning
1.35      matthew  2423: 
1.112     bowersj2 2424: =item * authform_nochange
1.35      matthew  2425: 
1.112     bowersj2 2426: =item * authform_kerberos
1.35      matthew  2427: 
1.112     bowersj2 2428: =item * authform_internal
1.35      matthew  2429: 
1.112     bowersj2 2430: =item * authform_filesystem
1.35      matthew  2431: 
                   2432: =back
                   2433: 
1.648     raeburn  2434: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2435: 
1.35      matthew  2436: =cut
                   2437: 
                   2438: #-------------------------------------------
1.32      matthew  2439: sub authform_header{  
                   2440:     my %in = (
                   2441:         formname => 'cu',
1.80      albertel 2442:         kerb_def_dom => '',
1.32      matthew  2443:         @_,
                   2444:     );
                   2445:     $in{'formname'} = 'document.' . $in{'formname'};
                   2446:     my $result='';
1.80      albertel 2447: 
                   2448: #---------------------------------------------- Code for upper case translation
                   2449:     my $Javascript_toUpperCase;
                   2450:     unless ($in{kerb_def_dom}) {
                   2451:         $Javascript_toUpperCase =<<"END";
                   2452:         switch (choice) {
                   2453:            case 'krb': currentform.elements[choicearg].value =
                   2454:                currentform.elements[choicearg].value.toUpperCase();
                   2455:                break;
                   2456:            default:
                   2457:         }
                   2458: END
                   2459:     } else {
                   2460:         $Javascript_toUpperCase = "";
                   2461:     }
                   2462: 
1.165     raeburn  2463:     my $radioval = "'nochange'";
1.591     raeburn  2464:     if (defined($in{'curr_authtype'})) {
                   2465:         if ($in{'curr_authtype'} ne '') {
                   2466:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2467:         }
1.174     matthew  2468:     }
1.165     raeburn  2469:     my $argfield = 'null';
1.591     raeburn  2470:     if (defined($in{'mode'})) {
1.165     raeburn  2471:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2472:             if (defined($in{'curr_autharg'})) {
                   2473:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2474:                     $argfield = "'$in{'curr_autharg'}'";
                   2475:                 }
                   2476:             }
                   2477:         }
                   2478:     }
                   2479: 
1.32      matthew  2480:     $result.=<<"END";
                   2481: var current = new Object();
1.165     raeburn  2482: current.radiovalue = $radioval;
                   2483: current.argfield = $argfield;
1.32      matthew  2484: 
                   2485: function changed_radio(choice,currentform) {
                   2486:     var choicearg = choice + 'arg';
                   2487:     // If a radio button in changed, we need to change the argfield
                   2488:     if (current.radiovalue != choice) {
                   2489:         current.radiovalue = choice;
                   2490:         if (current.argfield != null) {
                   2491:             currentform.elements[current.argfield].value = '';
                   2492:         }
                   2493:         if (choice == 'nochange') {
                   2494:             current.argfield = null;
                   2495:         } else {
                   2496:             current.argfield = choicearg;
                   2497:             switch(choice) {
                   2498:                 case 'krb': 
                   2499:                     currentform.elements[current.argfield].value = 
                   2500:                         "$in{'kerb_def_dom'}";
                   2501:                 break;
                   2502:               default:
                   2503:                 break;
                   2504:             }
                   2505:         }
                   2506:     }
                   2507:     return;
                   2508: }
1.22      www      2509: 
1.32      matthew  2510: function changed_text(choice,currentform) {
                   2511:     var choicearg = choice + 'arg';
                   2512:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2513:         $Javascript_toUpperCase
1.32      matthew  2514:         // clear old field
                   2515:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2516:             currentform.elements[current.argfield].value = '';
                   2517:         }
                   2518:         current.argfield = choicearg;
                   2519:     }
                   2520:     set_auth_radio_buttons(choice,currentform);
                   2521:     return;
1.20      www      2522: }
1.32      matthew  2523: 
                   2524: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2525:     var numauthchoices = currentform.login.length;
                   2526:     if (typeof numauthchoices  == "undefined") {
                   2527:         return;
                   2528:     } 
1.32      matthew  2529:     var i=0;
1.986     raeburn  2530:     while (i < numauthchoices) {
1.32      matthew  2531:         if (currentform.login[i].value == newvalue) { break; }
                   2532:         i++;
                   2533:     }
1.986     raeburn  2534:     if (i == numauthchoices) {
1.32      matthew  2535:         return;
                   2536:     }
                   2537:     current.radiovalue = newvalue;
                   2538:     currentform.login[i].checked = true;
                   2539:     return;
                   2540: }
                   2541: END
                   2542:     return $result;
                   2543: }
                   2544: 
1.1075.2.20  raeburn  2545: sub authform_authorwarning {
1.32      matthew  2546:     my $result='';
1.144     matthew  2547:     $result='<i>'.
                   2548:         &mt('As a general rule, only authors or co-authors should be '.
                   2549:             'filesystem authenticated '.
                   2550:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2551:     return $result;
                   2552: }
                   2553: 
1.1075.2.20  raeburn  2554: sub authform_nochange {
1.32      matthew  2555:     my %in = (
                   2556:               formname => 'document.cu',
                   2557:               kerb_def_dom => 'MSU.EDU',
                   2558:               @_,
                   2559:           );
1.1075.2.20  raeburn  2560:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2561:     my $result;
1.1075.2.20  raeburn  2562:     if (!$authnum) {
                   2563:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2564:     } else {
                   2565:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2566:                   '<input type="radio" name="login" value="nochange" '.
                   2567:                   'checked="checked" onclick="'.
1.281     albertel 2568:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2569: 	    '</label>';
1.586     raeburn  2570:     }
1.32      matthew  2571:     return $result;
                   2572: }
                   2573: 
1.591     raeburn  2574: sub authform_kerberos {
1.32      matthew  2575:     my %in = (
                   2576:               formname => 'document.cu',
                   2577:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2578:               kerb_def_auth => 'krb4',
1.32      matthew  2579:               @_,
                   2580:               );
1.586     raeburn  2581:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2582:         $autharg,$jscall);
1.1075.2.20  raeburn  2583:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2584:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2585:        $check5 = ' checked="checked"';
1.80      albertel 2586:     } else {
1.772     bisitz   2587:        $check4 = ' checked="checked"';
1.80      albertel 2588:     }
1.165     raeburn  2589:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2590:     if (defined($in{'curr_authtype'})) {
                   2591:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2592:             $krbcheck = ' checked="checked"';
1.623     raeburn  2593:             if (defined($in{'mode'})) {
                   2594:                 if ($in{'mode'} eq 'modifyuser') {
                   2595:                     $krbcheck = '';
                   2596:                 }
                   2597:             }
1.591     raeburn  2598:             if (defined($in{'curr_kerb_ver'})) {
                   2599:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2600:                     $check5 = ' checked="checked"';
1.591     raeburn  2601:                     $check4 = '';
                   2602:                 } else {
1.772     bisitz   2603:                     $check4 = ' checked="checked"';
1.591     raeburn  2604:                     $check5 = '';
                   2605:                 }
1.586     raeburn  2606:             }
1.591     raeburn  2607:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2608:                 $krbarg = $in{'curr_autharg'};
                   2609:             }
1.586     raeburn  2610:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2611:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2612:                     $result = 
                   2613:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2614:         $in{'curr_autharg'},$krbver);
                   2615:                 } else {
                   2616:                     $result =
                   2617:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2618:                 }
                   2619:                 return $result; 
                   2620:             }
                   2621:         }
                   2622:     } else {
                   2623:         if ($authnum == 1) {
1.784     bisitz   2624:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2625:         }
                   2626:     }
1.586     raeburn  2627:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2628:         return;
1.587     raeburn  2629:     } elsif ($authtype eq '') {
1.591     raeburn  2630:         if (defined($in{'mode'})) {
1.587     raeburn  2631:             if ($in{'mode'} eq 'modifycourse') {
                   2632:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2633:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2634:                 }
                   2635:             }
                   2636:         }
1.586     raeburn  2637:     }
                   2638:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2639:     if ($authtype eq '') {
                   2640:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2641:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2642:                     $krbcheck.' />';
                   2643:     }
                   2644:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20  raeburn  2645:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2646:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  2647:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2648:          $in{'curr_authtype'} eq 'krb4')) {
                   2649:         $result .= &mt
1.144     matthew  2650:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2651:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2652:          '<label>'.$authtype,
1.281     albertel 2653:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2654:              'value="'.$krbarg.'" '.
1.144     matthew  2655:              'onchange="'.$jscall.'" />',
1.281     albertel 2656:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2657:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2658: 	 '</label>');
1.586     raeburn  2659:     } elsif ($can_assign{'krb4'}) {
                   2660:         $result .= &mt
                   2661:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2662:          '[_3] Version 4 [_4]',
                   2663:          '<label>'.$authtype,
                   2664:          '</label><input type="text" size="10" name="krbarg" '.
                   2665:              'value="'.$krbarg.'" '.
                   2666:              'onchange="'.$jscall.'" />',
                   2667:          '<label><input type="hidden" name="krbver" value="4" />',
                   2668:          '</label>');
                   2669:     } elsif ($can_assign{'krb5'}) {
                   2670:         $result .= &mt
                   2671:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2672:          '[_3] Version 5 [_4]',
                   2673:          '<label>'.$authtype,
                   2674:          '</label><input type="text" size="10" name="krbarg" '.
                   2675:              'value="'.$krbarg.'" '.
                   2676:              'onchange="'.$jscall.'" />',
                   2677:          '<label><input type="hidden" name="krbver" value="5" />',
                   2678:          '</label>');
                   2679:     }
1.32      matthew  2680:     return $result;
                   2681: }
                   2682: 
1.1075.2.20  raeburn  2683: sub authform_internal {
1.586     raeburn  2684:     my %in = (
1.32      matthew  2685:                 formname => 'document.cu',
                   2686:                 kerb_def_dom => 'MSU.EDU',
                   2687:                 @_,
                   2688:                 );
1.586     raeburn  2689:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2690:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2691:     if (defined($in{'curr_authtype'})) {
                   2692:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2693:             if ($can_assign{'int'}) {
1.772     bisitz   2694:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2695:                 if (defined($in{'mode'})) {
                   2696:                     if ($in{'mode'} eq 'modifyuser') {
                   2697:                         $intcheck = '';
                   2698:                     }
                   2699:                 }
1.591     raeburn  2700:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2701:                     $intarg = $in{'curr_autharg'};
                   2702:                 }
                   2703:             } else {
                   2704:                 $result = &mt('Currently internally authenticated.');
                   2705:                 return $result;
1.165     raeburn  2706:             }
                   2707:         }
1.586     raeburn  2708:     } else {
                   2709:         if ($authnum == 1) {
1.784     bisitz   2710:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2711:         }
                   2712:     }
                   2713:     if (!$can_assign{'int'}) {
                   2714:         return;
1.587     raeburn  2715:     } elsif ($authtype eq '') {
1.591     raeburn  2716:         if (defined($in{'mode'})) {
1.587     raeburn  2717:             if ($in{'mode'} eq 'modifycourse') {
                   2718:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2719:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2720:                 }
                   2721:             }
                   2722:         }
1.165     raeburn  2723:     }
1.586     raeburn  2724:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2725:     if ($authtype eq '') {
                   2726:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2727:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2728:     }
1.605     bisitz   2729:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2730:                $intarg.'" onchange="'.$jscall.'" />';
                   2731:     $result = &mt
1.144     matthew  2732:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2733:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2734:     $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  2735:     return $result;
                   2736: }
                   2737: 
1.1075.2.20  raeburn  2738: sub authform_local {
1.32      matthew  2739:     my %in = (
                   2740:               formname => 'document.cu',
                   2741:               kerb_def_dom => 'MSU.EDU',
                   2742:               @_,
                   2743:               );
1.586     raeburn  2744:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2745:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2746:     if (defined($in{'curr_authtype'})) {
                   2747:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2748:             if ($can_assign{'loc'}) {
1.772     bisitz   2749:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2750:                 if (defined($in{'mode'})) {
                   2751:                     if ($in{'mode'} eq 'modifyuser') {
                   2752:                         $loccheck = '';
                   2753:                     }
                   2754:                 }
1.591     raeburn  2755:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2756:                     $locarg = $in{'curr_autharg'};
                   2757:                 }
                   2758:             } else {
                   2759:                 $result = &mt('Currently using local (institutional) authentication.');
                   2760:                 return $result;
1.165     raeburn  2761:             }
                   2762:         }
1.586     raeburn  2763:     } else {
                   2764:         if ($authnum == 1) {
1.784     bisitz   2765:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2766:         }
                   2767:     }
                   2768:     if (!$can_assign{'loc'}) {
                   2769:         return;
1.587     raeburn  2770:     } elsif ($authtype eq '') {
1.591     raeburn  2771:         if (defined($in{'mode'})) {
1.587     raeburn  2772:             if ($in{'mode'} eq 'modifycourse') {
                   2773:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2774:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2775:                 }
                   2776:             }
                   2777:         }
1.165     raeburn  2778:     }
1.586     raeburn  2779:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2780:     if ($authtype eq '') {
                   2781:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2782:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2783:                     $jscall.'" />';
                   2784:     }
                   2785:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2786:                $locarg.'" onchange="'.$jscall.'" />';
                   2787:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2788:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2789:     return $result;
                   2790: }
                   2791: 
1.1075.2.20  raeburn  2792: sub authform_filesystem {
1.32      matthew  2793:     my %in = (
                   2794:               formname => 'document.cu',
                   2795:               kerb_def_dom => 'MSU.EDU',
                   2796:               @_,
                   2797:               );
1.586     raeburn  2798:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2799:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2800:     if (defined($in{'curr_authtype'})) {
                   2801:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2802:             if ($can_assign{'fsys'}) {
1.772     bisitz   2803:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2804:                 if (defined($in{'mode'})) {
                   2805:                     if ($in{'mode'} eq 'modifyuser') {
                   2806:                         $fsyscheck = '';
                   2807:                     }
                   2808:                 }
1.586     raeburn  2809:             } else {
                   2810:                 $result = &mt('Currently Filesystem Authenticated.');
                   2811:                 return $result;
                   2812:             }           
                   2813:         }
                   2814:     } else {
                   2815:         if ($authnum == 1) {
1.784     bisitz   2816:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2817:         }
                   2818:     }
                   2819:     if (!$can_assign{'fsys'}) {
                   2820:         return;
1.587     raeburn  2821:     } elsif ($authtype eq '') {
1.591     raeburn  2822:         if (defined($in{'mode'})) {
1.587     raeburn  2823:             if ($in{'mode'} eq 'modifycourse') {
                   2824:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2825:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2826:                 }
                   2827:             }
                   2828:         }
1.586     raeburn  2829:     }
                   2830:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2831:     if ($authtype eq '') {
                   2832:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2833:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2834:                     $jscall.'" />';
                   2835:     }
                   2836:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2837:                ' onchange="'.$jscall.'" />';
                   2838:     $result = &mt
1.144     matthew  2839:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2840:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2841:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2842:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2843:                   'onchange="'.$jscall.'" />');
1.32      matthew  2844:     return $result;
                   2845: }
                   2846: 
1.586     raeburn  2847: sub get_assignable_auth {
                   2848:     my ($dom) = @_;
                   2849:     if ($dom eq '') {
                   2850:         $dom = $env{'request.role.domain'};
                   2851:     }
                   2852:     my %can_assign = (
                   2853:                           krb4 => 1,
                   2854:                           krb5 => 1,
                   2855:                           int  => 1,
                   2856:                           loc  => 1,
                   2857:                      );
                   2858:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2859:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2860:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2861:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2862:             my $context;
                   2863:             if ($env{'request.role'} =~ /^au/) {
                   2864:                 $context = 'author';
                   2865:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2866:                 $context = 'domain';
                   2867:             } elsif ($env{'request.course.id'}) {
                   2868:                 $context = 'course';
                   2869:             }
                   2870:             if ($context) {
                   2871:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2872:                    %can_assign = %{$authhash->{$context}}; 
                   2873:                 }
                   2874:             }
                   2875:         }
                   2876:     }
                   2877:     my $authnum = 0;
                   2878:     foreach my $key (keys(%can_assign)) {
                   2879:         if ($can_assign{$key}) {
                   2880:             $authnum ++;
                   2881:         }
                   2882:     }
                   2883:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2884:         $authnum --;
                   2885:     }
                   2886:     return ($authnum,%can_assign);
                   2887: }
                   2888: 
1.80      albertel 2889: ###############################################################
                   2890: ##    Get Kerberos Defaults for Domain                 ##
                   2891: ###############################################################
                   2892: ##
                   2893: ## Returns default kerberos version and an associated argument
                   2894: ## as listed in file domain.tab. If not listed, provides
                   2895: ## appropriate default domain and kerberos version.
                   2896: ##
                   2897: #-------------------------------------------
                   2898: 
                   2899: =pod
                   2900: 
1.648     raeburn  2901: =item * &get_kerberos_defaults()
1.80      albertel 2902: 
                   2903: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2904: version and domain. If not found, it defaults to version 4 and the 
                   2905: domain of the server.
1.80      albertel 2906: 
1.648     raeburn  2907: =over 4
                   2908: 
1.80      albertel 2909: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2910: 
1.648     raeburn  2911: =back
                   2912: 
                   2913: =back
                   2914: 
1.80      albertel 2915: =cut
                   2916: 
                   2917: #-------------------------------------------
                   2918: sub get_kerberos_defaults {
                   2919:     my $domain=shift;
1.641     raeburn  2920:     my ($krbdef,$krbdefdom);
                   2921:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2922:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2923:         $krbdef = $domdefaults{'auth_def'};
                   2924:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2925:     } else {
1.80      albertel 2926:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2927:         my $krbdefdom=$1;
                   2928:         $krbdefdom=~tr/a-z/A-Z/;
                   2929:         $krbdef = "krb4";
                   2930:     }
                   2931:     return ($krbdef,$krbdefdom);
                   2932: }
1.112     bowersj2 2933: 
1.32      matthew  2934: 
1.46      matthew  2935: ###############################################################
                   2936: ##                Thesaurus Functions                        ##
                   2937: ###############################################################
1.20      www      2938: 
1.46      matthew  2939: =pod
1.20      www      2940: 
1.112     bowersj2 2941: =head1 Thesaurus Functions
                   2942: 
                   2943: =over 4
                   2944: 
1.648     raeburn  2945: =item * &initialize_keywords()
1.46      matthew  2946: 
                   2947: Initializes the package variable %Keywords if it is empty.  Uses the
                   2948: package variable $thesaurus_db_file.
                   2949: 
                   2950: =cut
                   2951: 
                   2952: ###################################################
                   2953: 
                   2954: sub initialize_keywords {
                   2955:     return 1 if (scalar keys(%Keywords));
                   2956:     # If we are here, %Keywords is empty, so fill it up
                   2957:     #   Make sure the file we need exists...
                   2958:     if (! -e $thesaurus_db_file) {
                   2959:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2960:                                  " failed because it does not exist");
                   2961:         return 0;
                   2962:     }
                   2963:     #   Set up the hash as a database
                   2964:     my %thesaurus_db;
                   2965:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2966:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2967:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2968:                                  $thesaurus_db_file);
                   2969:         return 0;
                   2970:     } 
                   2971:     #  Get the average number of appearances of a word.
                   2972:     my $avecount = $thesaurus_db{'average.count'};
                   2973:     #  Put keywords (those that appear > average) into %Keywords
                   2974:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2975:         my ($count,undef) = split /:/,$data;
                   2976:         $Keywords{$word}++ if ($count > $avecount);
                   2977:     }
                   2978:     untie %thesaurus_db;
                   2979:     # Remove special values from %Keywords.
1.356     albertel 2980:     foreach my $value ('total.count','average.count') {
                   2981:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2982:   }
1.46      matthew  2983:     return 1;
                   2984: }
                   2985: 
                   2986: ###################################################
                   2987: 
                   2988: =pod
                   2989: 
1.648     raeburn  2990: =item * &keyword($word)
1.46      matthew  2991: 
                   2992: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2993: than the average number of times in the thesaurus database.  Calls 
                   2994: &initialize_keywords
                   2995: 
                   2996: =cut
                   2997: 
                   2998: ###################################################
1.20      www      2999: 
                   3000: sub keyword {
1.46      matthew  3001:     return if (!&initialize_keywords());
                   3002:     my $word=lc(shift());
                   3003:     $word=~s/\W//g;
                   3004:     return exists($Keywords{$word});
1.20      www      3005: }
1.46      matthew  3006: 
                   3007: ###############################################################
                   3008: 
                   3009: =pod 
1.20      www      3010: 
1.648     raeburn  3011: =item * &get_related_words()
1.46      matthew  3012: 
1.160     matthew  3013: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3014: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3015: will be returned.  The order of the words returned is determined by the
                   3016: database which holds them.
                   3017: 
                   3018: Uses global $thesaurus_db_file.
                   3019: 
1.1057    foxr     3020: 
1.46      matthew  3021: =cut
                   3022: 
                   3023: ###############################################################
                   3024: sub get_related_words {
                   3025:     my $keyword = shift;
                   3026:     my %thesaurus_db;
                   3027:     if (! -e $thesaurus_db_file) {
                   3028:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3029:                                  "failed because the file does not exist");
                   3030:         return ();
                   3031:     }
                   3032:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3033:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3034:         return ();
                   3035:     } 
                   3036:     my @Words=();
1.429     www      3037:     my $count=0;
1.46      matthew  3038:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3039: 	# The first element is the number of times
                   3040: 	# the word appears.  We do not need it now.
1.429     www      3041: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3042: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3043: 	my $threshold=$mostfrequentcount/10;
                   3044:         foreach my $possibleword (@RelatedWords) {
                   3045:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3046:             if ($wordcount>$threshold) {
                   3047: 		push(@Words,$word);
                   3048:                 $count++;
                   3049:                 if ($count>10) { last; }
                   3050: 	    }
1.20      www      3051:         }
                   3052:     }
1.46      matthew  3053:     untie %thesaurus_db;
                   3054:     return @Words;
1.14      harris41 3055: }
1.46      matthew  3056: 
1.112     bowersj2 3057: =pod
                   3058: 
                   3059: =back
                   3060: 
                   3061: =cut
1.61      www      3062: 
                   3063: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3064: =pod
                   3065: 
1.112     bowersj2 3066: =head1 User Name Functions
                   3067: 
                   3068: =over 4
                   3069: 
1.648     raeburn  3070: =item * &plainname($uname,$udom,$first)
1.81      albertel 3071: 
1.112     bowersj2 3072: Takes a users logon name and returns it as a string in
1.226     albertel 3073: "first middle last generation" form 
                   3074: if $first is set to 'lastname' then it returns it as
                   3075: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3076: 
                   3077: =cut
1.61      www      3078: 
1.295     www      3079: 
1.81      albertel 3080: ###############################################################
1.61      www      3081: sub plainname {
1.226     albertel 3082:     my ($uname,$udom,$first)=@_;
1.537     albertel 3083:     return if (!defined($uname) || !defined($udom));
1.295     www      3084:     my %names=&getnames($uname,$udom);
1.226     albertel 3085:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3086: 					  $names{'middlename'},
                   3087: 					  $names{'lastname'},
                   3088: 					  $names{'generation'},$first);
                   3089:     $name=~s/^\s+//;
1.62      www      3090:     $name=~s/\s+$//;
                   3091:     $name=~s/\s+/ /g;
1.353     albertel 3092:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3093:     return $name;
1.61      www      3094: }
1.66      www      3095: 
                   3096: # -------------------------------------------------------------------- Nickname
1.81      albertel 3097: =pod
                   3098: 
1.648     raeburn  3099: =item * &nickname($uname,$udom)
1.81      albertel 3100: 
                   3101: Gets a users name and returns it as a string as
                   3102: 
                   3103: "&quot;nickname&quot;"
1.66      www      3104: 
1.81      albertel 3105: if the user has a nickname or
                   3106: 
                   3107: "first middle last generation"
                   3108: 
                   3109: if the user does not
                   3110: 
                   3111: =cut
1.66      www      3112: 
                   3113: sub nickname {
                   3114:     my ($uname,$udom)=@_;
1.537     albertel 3115:     return if (!defined($uname) || !defined($udom));
1.295     www      3116:     my %names=&getnames($uname,$udom);
1.68      albertel 3117:     my $name=$names{'nickname'};
1.66      www      3118:     if ($name) {
                   3119:        $name='&quot;'.$name.'&quot;'; 
                   3120:     } else {
                   3121:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3122: 	     $names{'lastname'}.' '.$names{'generation'};
                   3123:        $name=~s/\s+$//;
                   3124:        $name=~s/\s+/ /g;
                   3125:     }
                   3126:     return $name;
                   3127: }
                   3128: 
1.295     www      3129: sub getnames {
                   3130:     my ($uname,$udom)=@_;
1.537     albertel 3131:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3132:     if ($udom eq 'public' && $uname eq 'public') {
                   3133: 	return ('lastname' => &mt('Public'));
                   3134:     }
1.295     www      3135:     my $id=$uname.':'.$udom;
                   3136:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3137:     if ($cached) {
                   3138: 	return %{$names};
                   3139:     } else {
                   3140: 	my %loadnames=&Apache::lonnet::get('environment',
                   3141:                     ['firstname','middlename','lastname','generation','nickname'],
                   3142: 					 $udom,$uname);
                   3143: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3144: 	return %loadnames;
                   3145:     }
                   3146: }
1.61      www      3147: 
1.542     raeburn  3148: # -------------------------------------------------------------------- getemails
1.648     raeburn  3149: 
1.542     raeburn  3150: =pod
                   3151: 
1.648     raeburn  3152: =item * &getemails($uname,$udom)
1.542     raeburn  3153: 
                   3154: Gets a user's email information and returns it as a hash with keys:
                   3155: notification, critnotification, permanentemail
                   3156: 
                   3157: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3158: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3159:  
1.648     raeburn  3160: 
1.542     raeburn  3161: =cut
                   3162: 
1.648     raeburn  3163: 
1.466     albertel 3164: sub getemails {
                   3165:     my ($uname,$udom)=@_;
                   3166:     if ($udom eq 'public' && $uname eq 'public') {
                   3167: 	return;
                   3168:     }
1.467     www      3169:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3170:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3171:     my $id=$uname.':'.$udom;
                   3172:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3173:     if ($cached) {
                   3174: 	return %{$names};
                   3175:     } else {
                   3176: 	my %loadnames=&Apache::lonnet::get('environment',
                   3177:                     			   ['notification','critnotification',
                   3178: 					    'permanentemail'],
                   3179: 					   $udom,$uname);
                   3180: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3181: 	return %loadnames;
                   3182:     }
                   3183: }
                   3184: 
1.551     albertel 3185: sub flush_email_cache {
                   3186:     my ($uname,$udom)=@_;
                   3187:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3188:     if (!$uname) { $uname=$env{'user.name'};   }
                   3189:     return if ($udom eq 'public' && $uname eq 'public');
                   3190:     my $id=$uname.':'.$udom;
                   3191:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3192: }
                   3193: 
1.728     raeburn  3194: # -------------------------------------------------------------------- getlangs
                   3195: 
                   3196: =pod
                   3197: 
                   3198: =item * &getlangs($uname,$udom)
                   3199: 
                   3200: Gets a user's language preference and returns it as a hash with key:
                   3201: language.
                   3202: 
                   3203: =cut
                   3204: 
                   3205: 
                   3206: sub getlangs {
                   3207:     my ($uname,$udom) = @_;
                   3208:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3209:     if (!$uname) { $uname=$env{'user.name'};   }
                   3210:     my $id=$uname.':'.$udom;
                   3211:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3212:     if ($cached) {
                   3213:         return %{$langs};
                   3214:     } else {
                   3215:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3216:                                            $udom,$uname);
                   3217:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3218:         return %loadlangs;
                   3219:     }
                   3220: }
                   3221: 
                   3222: sub flush_langs_cache {
                   3223:     my ($uname,$udom)=@_;
                   3224:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3225:     if (!$uname) { $uname=$env{'user.name'};   }
                   3226:     return if ($udom eq 'public' && $uname eq 'public');
                   3227:     my $id=$uname.':'.$udom;
                   3228:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3229: }
                   3230: 
1.61      www      3231: # ------------------------------------------------------------------ Screenname
1.81      albertel 3232: 
                   3233: =pod
                   3234: 
1.648     raeburn  3235: =item * &screenname($uname,$udom)
1.81      albertel 3236: 
                   3237: Gets a users screenname and returns it as a string
                   3238: 
                   3239: =cut
1.61      www      3240: 
                   3241: sub screenname {
                   3242:     my ($uname,$udom)=@_;
1.258     albertel 3243:     if ($uname eq $env{'user.name'} &&
                   3244: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3245:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3246:     return $names{'screenname'};
1.62      www      3247: }
                   3248: 
1.212     albertel 3249: 
1.802     bisitz   3250: # ------------------------------------------------------------- Confirm Wrapper
                   3251: =pod
                   3252: 
1.1075.2.42  raeburn  3253: =item * &confirmwrapper($message)
1.802     bisitz   3254: 
                   3255: Wrap messages about completion of operation in box
                   3256: 
                   3257: =cut
                   3258: 
                   3259: sub confirmwrapper {
                   3260:     my ($message)=@_;
                   3261:     if ($message) {
                   3262:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3263:                .$message."\n"
                   3264:                .'</div>'."\n";
                   3265:     } else {
                   3266:         return $message;
                   3267:     }
                   3268: }
                   3269: 
1.62      www      3270: # ------------------------------------------------------------- Message Wrapper
                   3271: 
                   3272: sub messagewrapper {
1.369     www      3273:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3274:     return 
1.441     albertel 3275:         '<a href="/adm/email?compose=individual&amp;'.
                   3276:         'recname='.$username.'&amp;recdom='.$domain.
                   3277: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3278:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3279: }
1.802     bisitz   3280: 
1.74      www      3281: # --------------------------------------------------------------- Notes Wrapper
                   3282: 
                   3283: sub noteswrapper {
                   3284:     my ($link,$un,$do)=@_;
                   3285:     return 
1.896     amueller 3286: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3287: }
1.802     bisitz   3288: 
1.62      www      3289: # ------------------------------------------------------------- Aboutme Wrapper
                   3290: 
                   3291: sub aboutmewrapper {
1.1070    raeburn  3292:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3293:     if (!defined($username)  && !defined($domain)) {
                   3294:         return;
                   3295:     }
1.1075.2.15  raeburn  3296:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3297: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3298: }
                   3299: 
                   3300: # ------------------------------------------------------------ Syllabus Wrapper
                   3301: 
                   3302: sub syllabuswrapper {
1.707     bisitz   3303:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3304:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3305: }
1.14      harris41 3306: 
1.802     bisitz   3307: # -----------------------------------------------------------------------------
                   3308: 
1.208     matthew  3309: sub track_student_link {
1.887     raeburn  3310:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3311:     my $link ="/adm/trackstudent?";
1.208     matthew  3312:     my $title = 'View recent activity';
                   3313:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3314:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3315:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3316:         $title .= ' of this student';
1.268     albertel 3317:     } 
1.208     matthew  3318:     if (defined($target) && $target !~ /^\s*$/) {
                   3319:         $target = qq{target="$target"};
                   3320:     } else {
                   3321:         $target = '';
                   3322:     }
1.268     albertel 3323:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3324:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3325:     $title = &mt($title);
                   3326:     $linktext = &mt($linktext);
1.448     albertel 3327:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3328: 	&help_open_topic('View_recent_activity');
1.208     matthew  3329: }
                   3330: 
1.781     raeburn  3331: sub slot_reservations_link {
                   3332:     my ($linktext,$sname,$sdom,$target) = @_;
                   3333:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3334:     my $title = 'View slot reservation history';
                   3335:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3336:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3337:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3338:         $title .= ' of this student';
                   3339:     }
                   3340:     if (defined($target) && $target !~ /^\s*$/) {
                   3341:         $target = qq{target="$target"};
                   3342:     } else {
                   3343:         $target = '';
                   3344:     }
                   3345:     $title = &mt($title);
                   3346:     $linktext = &mt($linktext);
                   3347:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3348: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3349: 
                   3350: }
                   3351: 
1.508     www      3352: # ===================================================== Display a student photo
                   3353: 
                   3354: 
1.509     albertel 3355: sub student_image_tag {
1.508     www      3356:     my ($domain,$user)=@_;
                   3357:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3358:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3359: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3360:     } else {
                   3361: 	return '';
                   3362:     }
                   3363: }
                   3364: 
1.112     bowersj2 3365: =pod
                   3366: 
                   3367: =back
                   3368: 
                   3369: =head1 Access .tab File Data
                   3370: 
                   3371: =over 4
                   3372: 
1.648     raeburn  3373: =item * &languageids() 
1.112     bowersj2 3374: 
                   3375: returns list of all language ids
                   3376: 
                   3377: =cut
                   3378: 
1.14      harris41 3379: sub languageids {
1.16      harris41 3380:     return sort(keys(%language));
1.14      harris41 3381: }
                   3382: 
1.112     bowersj2 3383: =pod
                   3384: 
1.648     raeburn  3385: =item * &languagedescription() 
1.112     bowersj2 3386: 
                   3387: returns description of a specified language id
                   3388: 
                   3389: =cut
                   3390: 
1.14      harris41 3391: sub languagedescription {
1.125     www      3392:     my $code=shift;
                   3393:     return  ($supported_language{$code}?'* ':'').
                   3394:             $language{$code}.
1.126     www      3395: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3396: }
                   3397: 
1.1048    foxr     3398: =pod
                   3399: 
                   3400: =item * &plainlanguagedescription
                   3401: 
                   3402: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3403: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3404: 
                   3405: =cut
                   3406: 
1.145     www      3407: sub plainlanguagedescription {
                   3408:     my $code=shift;
                   3409:     return $language{$code};
                   3410: }
                   3411: 
1.1048    foxr     3412: =pod
                   3413: 
                   3414: =item * &supportedlanguagecode
                   3415: 
                   3416: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3417: code.
                   3418: 
                   3419: =cut
                   3420: 
1.145     www      3421: sub supportedlanguagecode {
                   3422:     my $code=shift;
                   3423:     return $supported_language{$code};
1.97      www      3424: }
                   3425: 
1.112     bowersj2 3426: =pod
                   3427: 
1.1048    foxr     3428: =item * &latexlanguage()
                   3429: 
                   3430: Given a language key code returns the correspondnig language to use
                   3431: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3432: is no supported hyphenation for the language code.
                   3433: 
                   3434: =cut
                   3435: 
                   3436: sub latexlanguage {
                   3437:     my $code = shift;
                   3438:     return $latex_language{$code};
                   3439: }
                   3440: 
                   3441: =pod
                   3442: 
                   3443: =item * &latexhyphenation()
                   3444: 
                   3445: Same as above but what's supplied is the language as it might be stored
                   3446: in the metadata.
                   3447: 
                   3448: =cut
                   3449: 
                   3450: sub latexhyphenation {
                   3451:     my $key = shift;
                   3452:     return $latex_language_bykey{$key};
                   3453: }
                   3454: 
                   3455: =pod
                   3456: 
1.648     raeburn  3457: =item * &copyrightids() 
1.112     bowersj2 3458: 
                   3459: returns list of all copyrights
                   3460: 
                   3461: =cut
                   3462: 
                   3463: sub copyrightids {
                   3464:     return sort(keys(%cprtag));
                   3465: }
                   3466: 
                   3467: =pod
                   3468: 
1.648     raeburn  3469: =item * &copyrightdescription() 
1.112     bowersj2 3470: 
                   3471: returns description of a specified copyright id
                   3472: 
                   3473: =cut
                   3474: 
                   3475: sub copyrightdescription {
1.166     www      3476:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3477: }
1.197     matthew  3478: 
                   3479: =pod
                   3480: 
1.648     raeburn  3481: =item * &source_copyrightids() 
1.192     taceyjo1 3482: 
                   3483: returns list of all source copyrights
                   3484: 
                   3485: =cut
                   3486: 
                   3487: sub source_copyrightids {
                   3488:     return sort(keys(%scprtag));
                   3489: }
                   3490: 
                   3491: =pod
                   3492: 
1.648     raeburn  3493: =item * &source_copyrightdescription() 
1.192     taceyjo1 3494: 
                   3495: returns description of a specified source copyright id
                   3496: 
                   3497: =cut
                   3498: 
                   3499: sub source_copyrightdescription {
                   3500:     return &mt($scprtag{shift(@_)});
                   3501: }
1.112     bowersj2 3502: 
                   3503: =pod
                   3504: 
1.648     raeburn  3505: =item * &filecategories() 
1.112     bowersj2 3506: 
                   3507: returns list of all file categories
                   3508: 
                   3509: =cut
                   3510: 
                   3511: sub filecategories {
                   3512:     return sort(keys(%category_extensions));
                   3513: }
                   3514: 
                   3515: =pod
                   3516: 
1.648     raeburn  3517: =item * &filecategorytypes() 
1.112     bowersj2 3518: 
                   3519: returns list of file types belonging to a given file
                   3520: category
                   3521: 
                   3522: =cut
                   3523: 
                   3524: sub filecategorytypes {
1.356     albertel 3525:     my ($cat) = @_;
                   3526:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3527: }
                   3528: 
                   3529: =pod
                   3530: 
1.648     raeburn  3531: =item * &fileembstyle() 
1.112     bowersj2 3532: 
                   3533: returns embedding style for a specified file type
                   3534: 
                   3535: =cut
                   3536: 
                   3537: sub fileembstyle {
                   3538:     return $fe{lc(shift(@_))};
1.169     www      3539: }
                   3540: 
1.351     www      3541: sub filemimetype {
                   3542:     return $fm{lc(shift(@_))};
                   3543: }
                   3544: 
1.169     www      3545: 
                   3546: sub filecategoryselect {
                   3547:     my ($name,$value)=@_;
1.189     matthew  3548:     return &select_form($value,$name,
1.970     raeburn  3549:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3550: }
                   3551: 
                   3552: =pod
                   3553: 
1.648     raeburn  3554: =item * &filedescription() 
1.112     bowersj2 3555: 
                   3556: returns description for a specified file type
                   3557: 
                   3558: =cut
                   3559: 
                   3560: sub filedescription {
1.188     matthew  3561:     my $file_description = $fd{lc(shift())};
                   3562:     $file_description =~ s:([\[\]]):~$1:g;
                   3563:     return &mt($file_description);
1.112     bowersj2 3564: }
                   3565: 
                   3566: =pod
                   3567: 
1.648     raeburn  3568: =item * &filedescriptionex() 
1.112     bowersj2 3569: 
                   3570: returns description for a specified file type with
                   3571: extra formatting
                   3572: 
                   3573: =cut
                   3574: 
                   3575: sub filedescriptionex {
                   3576:     my $ex=shift;
1.188     matthew  3577:     my $file_description = $fd{lc($ex)};
                   3578:     $file_description =~ s:([\[\]]):~$1:g;
                   3579:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3580: }
                   3581: 
                   3582: # End of .tab access
                   3583: =pod
                   3584: 
                   3585: =back
                   3586: 
                   3587: =cut
                   3588: 
                   3589: # ------------------------------------------------------------------ File Types
                   3590: sub fileextensions {
                   3591:     return sort(keys(%fe));
                   3592: }
                   3593: 
1.97      www      3594: # ----------------------------------------------------------- Display Languages
                   3595: # returns a hash with all desired display languages
                   3596: #
                   3597: 
                   3598: sub display_languages {
                   3599:     my %languages=();
1.695     raeburn  3600:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3601: 	$languages{$lang}=1;
1.97      www      3602:     }
                   3603:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3604:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3605: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3606: 	    $languages{$lang}=1;
1.97      www      3607:         }
                   3608:     }
                   3609:     return %languages;
1.14      harris41 3610: }
                   3611: 
1.582     albertel 3612: sub languages {
                   3613:     my ($possible_langs) = @_;
1.695     raeburn  3614:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3615:     if (!ref($possible_langs)) {
                   3616: 	if( wantarray ) {
                   3617: 	    return @preferred_langs;
                   3618: 	} else {
                   3619: 	    return $preferred_langs[0];
                   3620: 	}
                   3621:     }
                   3622:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3623:     my @preferred_possibilities;
                   3624:     foreach my $preferred_lang (@preferred_langs) {
                   3625: 	if (exists($possibilities{$preferred_lang})) {
                   3626: 	    push(@preferred_possibilities, $preferred_lang);
                   3627: 	}
                   3628:     }
                   3629:     if( wantarray ) {
                   3630: 	return @preferred_possibilities;
                   3631:     }
                   3632:     return $preferred_possibilities[0];
                   3633: }
                   3634: 
1.742     raeburn  3635: sub user_lang {
                   3636:     my ($touname,$toudom,$fromcid) = @_;
                   3637:     my @userlangs;
                   3638:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3639:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3640:                     $env{'course.'.$fromcid.'.languages'}));
                   3641:     } else {
                   3642:         my %langhash = &getlangs($touname,$toudom);
                   3643:         if ($langhash{'languages'} ne '') {
                   3644:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3645:         } else {
                   3646:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3647:             if ($domdefs{'lang_def'} ne '') {
                   3648:                 @userlangs = ($domdefs{'lang_def'});
                   3649:             }
                   3650:         }
                   3651:     }
                   3652:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3653:     my $user_lh = Apache::localize->get_handle(@languages);
                   3654:     return $user_lh;
                   3655: }
                   3656: 
                   3657: 
1.112     bowersj2 3658: ###############################################################
                   3659: ##               Student Answer Attempts                     ##
                   3660: ###############################################################
                   3661: 
                   3662: =pod
                   3663: 
                   3664: =head1 Alternate Problem Views
                   3665: 
                   3666: =over 4
                   3667: 
1.648     raeburn  3668: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3669:     $getattempt, $regexp, $gradesub)
                   3670: 
                   3671: Return string with previous attempt on problem. Arguments:
                   3672: 
                   3673: =over 4
                   3674: 
                   3675: =item * $symb: Problem, including path
                   3676: 
                   3677: =item * $username: username of the desired student
                   3678: 
                   3679: =item * $domain: domain of the desired student
1.14      harris41 3680: 
1.112     bowersj2 3681: =item * $course: Course ID
1.14      harris41 3682: 
1.112     bowersj2 3683: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3684:     something
1.14      harris41 3685: 
1.112     bowersj2 3686: =item * $regexp: if string matches this regexp, the string will be
                   3687:     sent to $gradesub
1.14      harris41 3688: 
1.112     bowersj2 3689: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3690: 
1.112     bowersj2 3691: =back
1.14      harris41 3692: 
1.112     bowersj2 3693: The output string is a table containing all desired attempts, if any.
1.16      harris41 3694: 
1.112     bowersj2 3695: =cut
1.1       albertel 3696: 
                   3697: sub get_previous_attempt {
1.43      ng       3698:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3699:   my $prevattempts='';
1.43      ng       3700:   no strict 'refs';
1.1       albertel 3701:   if ($symb) {
1.3       albertel 3702:     my (%returnhash)=
                   3703:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3704:     if ($returnhash{'version'}) {
                   3705:       my %lasthash=();
                   3706:       my $version;
                   3707:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3708:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3709: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3710:         }
1.1       albertel 3711:       }
1.596     albertel 3712:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3713:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3714:       my (%typeparts,%lasthidden);
1.945     raeburn  3715:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3716:       foreach my $key (sort(keys(%lasthash))) {
                   3717: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3718: 	if ($#parts > 0) {
1.31      albertel 3719: 	  my $data=$parts[-1];
1.989     raeburn  3720:           next if ($data eq 'foilorder');
1.31      albertel 3721: 	  pop(@parts);
1.1010    www      3722:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3723:           if ($data eq 'type') {
                   3724:               unless ($showsurv) {
                   3725:                   my $id = join(',',@parts);
                   3726:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3727:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3728:                       $lasthidden{$ign.'.'.$id} = 1;
                   3729:                   }
1.945     raeburn  3730:               }
1.1010    www      3731:           } 
1.31      albertel 3732: 	} else {
1.41      ng       3733: 	  if ($#parts == 0) {
                   3734: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3735: 	  } else {
                   3736: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3737: 	  }
1.31      albertel 3738: 	}
1.16      harris41 3739:       }
1.596     albertel 3740:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3741:       if ($getattempt eq '') {
                   3742: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3743:             my @hidden;
                   3744:             if (%typeparts) {
                   3745:                 foreach my $id (keys(%typeparts)) {
                   3746:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3747:                         push(@hidden,$id);
                   3748:                     }
                   3749:                 }
                   3750:             }
                   3751:             $prevattempts.=&start_data_table_row().
                   3752:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3753:             if (@hidden) {
                   3754:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3755:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3756:                     my $hide;
                   3757:                     foreach my $id (@hidden) {
                   3758:                         if ($key =~ /^\Q$id\E/) {
                   3759:                             $hide = 1;
                   3760:                             last;
                   3761:                         }
                   3762:                     }
                   3763:                     if ($hide) {
                   3764:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3765:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3766:                             my $value = &format_previous_attempt_value($key,
                   3767:                                              $returnhash{$version.':'.$key});
                   3768:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3769:                         } else {
                   3770:                             $prevattempts.='<td>&nbsp;</td>';
                   3771:                         }
                   3772:                     } else {
                   3773:                         if ($key =~ /\./) {
                   3774:                             my $value = &format_previous_attempt_value($key,
                   3775:                                               $returnhash{$version.':'.$key});
                   3776:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3777:                         } else {
                   3778:                             $prevattempts.='<td>&nbsp;</td>';
                   3779:                         }
                   3780:                     }
                   3781:                 }
                   3782:             } else {
                   3783: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3784:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3785: 		    my $value = &format_previous_attempt_value($key,
                   3786: 			            $returnhash{$version.':'.$key});
                   3787: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3788: 	        }
                   3789:             }
                   3790: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3791: 	 }
1.1       albertel 3792:       }
1.945     raeburn  3793:       my @currhidden = keys(%lasthidden);
1.596     albertel 3794:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3795:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3796:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3797:           if (%typeparts) {
                   3798:               my $hidden;
                   3799:               foreach my $id (@currhidden) {
                   3800:                   if ($key =~ /^\Q$id\E/) {
                   3801:                       $hidden = 1;
                   3802:                       last;
                   3803:                   }
                   3804:               }
                   3805:               if ($hidden) {
                   3806:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3807:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3808:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3809:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3810:                           $value = &$gradesub($value);
                   3811:                       }
                   3812:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3813:                   } else {
                   3814:                       $prevattempts.='<td>&nbsp;</td>';
                   3815:                   }
                   3816:               } else {
                   3817:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3818:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3819:                       $value = &$gradesub($value);
                   3820:                   }
                   3821:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3822:               }
                   3823:           } else {
                   3824: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3825: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3826:                   $value = &$gradesub($value);
                   3827:               }
                   3828: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3829:           }
1.16      harris41 3830:       }
1.596     albertel 3831:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3832:     } else {
1.596     albertel 3833:       $prevattempts=
                   3834: 	  &start_data_table().&start_data_table_row().
                   3835: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3836: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3837:     }
                   3838:   } else {
1.596     albertel 3839:     $prevattempts=
                   3840: 	  &start_data_table().&start_data_table_row().
                   3841: 	  '<td>'.&mt('No data.').'</td>'.
                   3842: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3843:   }
1.10      albertel 3844: }
                   3845: 
1.581     albertel 3846: sub format_previous_attempt_value {
                   3847:     my ($key,$value) = @_;
1.1011    www      3848:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3849: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3850:     } elsif (ref($value) eq 'ARRAY') {
                   3851: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3852:     } elsif ($key =~ /answerstring$/) {
                   3853:         my %answers = &Apache::lonnet::str2hash($value);
                   3854:         my @anskeys = sort(keys(%answers));
                   3855:         if (@anskeys == 1) {
                   3856:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3857:             if ($answer =~ m{\0}) {
                   3858:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3859:             }
                   3860:             my $tag_internal_answer_name = 'INTERNAL';
                   3861:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3862:                 $value = $answer; 
                   3863:             } else {
                   3864:                 $value = $anskeys[0].'='.$answer;
                   3865:             }
                   3866:         } else {
                   3867:             foreach my $ans (@anskeys) {
                   3868:                 my $answer = $answers{$ans};
1.1001    raeburn  3869:                 if ($answer =~ m{\0}) {
                   3870:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3871:                 }
                   3872:                 $value .=  $ans.'='.$answer.'<br />';;
                   3873:             } 
                   3874:         }
1.581     albertel 3875:     } else {
                   3876: 	$value = &unescape($value);
                   3877:     }
                   3878:     return $value;
                   3879: }
                   3880: 
                   3881: 
1.107     albertel 3882: sub relative_to_absolute {
                   3883:     my ($url,$output)=@_;
                   3884:     my $parser=HTML::TokeParser->new(\$output);
                   3885:     my $token;
                   3886:     my $thisdir=$url;
                   3887:     my @rlinks=();
                   3888:     while ($token=$parser->get_token) {
                   3889: 	if ($token->[0] eq 'S') {
                   3890: 	    if ($token->[1] eq 'a') {
                   3891: 		if ($token->[2]->{'href'}) {
                   3892: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3893: 		}
                   3894: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3895: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3896: 	    } elsif ($token->[1] eq 'base') {
                   3897: 		$thisdir=$token->[2]->{'href'};
                   3898: 	    }
                   3899: 	}
                   3900:     }
                   3901:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3902:     foreach my $link (@rlinks) {
1.726     raeburn  3903: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3904: 		($link=~/^\//) ||
                   3905: 		($link=~/^javascript:/i) ||
                   3906: 		($link=~/^mailto:/i) ||
                   3907: 		($link=~/^\#/)) {
                   3908: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3909: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3910: 	}
                   3911:     }
                   3912: # -------------------------------------------------- Deal with Applet codebases
                   3913:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3914:     return $output;
                   3915: }
                   3916: 
1.112     bowersj2 3917: =pod
                   3918: 
1.648     raeburn  3919: =item * &get_student_view()
1.112     bowersj2 3920: 
                   3921: show a snapshot of what student was looking at
                   3922: 
                   3923: =cut
                   3924: 
1.10      albertel 3925: sub get_student_view {
1.186     albertel 3926:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3927:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3928:   my (%form);
1.10      albertel 3929:   my @elements=('symb','courseid','domain','username');
                   3930:   foreach my $element (@elements) {
1.186     albertel 3931:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3932:   }
1.186     albertel 3933:   if (defined($moreenv)) {
                   3934:       %form=(%form,%{$moreenv});
                   3935:   }
1.236     albertel 3936:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3937:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3938:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3939:   $userview=~s/\<body[^\>]*\>//gi;
                   3940:   $userview=~s/\<\/body\>//gi;
                   3941:   $userview=~s/\<html\>//gi;
                   3942:   $userview=~s/\<\/html\>//gi;
                   3943:   $userview=~s/\<head\>//gi;
                   3944:   $userview=~s/\<\/head\>//gi;
                   3945:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3946:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3947:   if (wantarray) {
                   3948:      return ($userview,$response);
                   3949:   } else {
                   3950:      return $userview;
                   3951:   }
                   3952: }
                   3953: 
                   3954: sub get_student_view_with_retries {
                   3955:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3956: 
                   3957:     my $ok = 0;                 # True if we got a good response.
                   3958:     my $content;
                   3959:     my $response;
                   3960: 
                   3961:     # Try to get the student_view done. within the retries count:
                   3962:     
                   3963:     do {
                   3964:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3965:          $ok      = $response->is_success;
                   3966:          if (!$ok) {
                   3967:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3968:          }
                   3969:          $retries--;
                   3970:     } while (!$ok && ($retries > 0));
                   3971:     
                   3972:     if (!$ok) {
                   3973:        $content = '';          # On error return an empty content.
                   3974:     }
1.651     www      3975:     if (wantarray) {
                   3976:        return ($content, $response);
                   3977:     } else {
                   3978:        return $content;
                   3979:     }
1.11      albertel 3980: }
                   3981: 
1.112     bowersj2 3982: =pod
                   3983: 
1.648     raeburn  3984: =item * &get_student_answers() 
1.112     bowersj2 3985: 
                   3986: show a snapshot of how student was answering problem
                   3987: 
                   3988: =cut
                   3989: 
1.11      albertel 3990: sub get_student_answers {
1.100     sakharuk 3991:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3992:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3993:   my (%moreenv);
1.11      albertel 3994:   my @elements=('symb','courseid','domain','username');
                   3995:   foreach my $element (@elements) {
1.186     albertel 3996:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3997:   }
1.186     albertel 3998:   $moreenv{'grade_target'}='answer';
                   3999:   %moreenv=(%form,%moreenv);
1.497     raeburn  4000:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4001:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4002:   return $userview;
1.1       albertel 4003: }
1.116     albertel 4004: 
                   4005: =pod
                   4006: 
                   4007: =item * &submlink()
                   4008: 
1.242     albertel 4009: Inputs: $text $uname $udom $symb $target
1.116     albertel 4010: 
                   4011: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4012: 
                   4013: =cut
                   4014: 
                   4015: ###############################################
                   4016: sub submlink {
1.242     albertel 4017:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4018:     if (!($uname && $udom)) {
                   4019: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4020: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4021: 	if (!$symb) { $symb=$cursymb; }
                   4022:     }
1.254     matthew  4023:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4024:     $symb=&escape($symb);
1.960     bisitz   4025:     if ($target) { $target=" target=\"$target\""; }
                   4026:     return
                   4027:         '<a href="/adm/grades?command=submission'.
                   4028:         '&amp;symb='.$symb.
                   4029:         '&amp;student='.$uname.
                   4030:         '&amp;userdom='.$udom.'"'.
                   4031:         $target.'>'.$text.'</a>';
1.242     albertel 4032: }
                   4033: ##############################################
                   4034: 
                   4035: =pod
                   4036: 
                   4037: =item * &pgrdlink()
                   4038: 
                   4039: Inputs: $text $uname $udom $symb $target
                   4040: 
                   4041: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4042: 
                   4043: =cut
                   4044: 
                   4045: ###############################################
                   4046: sub pgrdlink {
                   4047:     my $link=&submlink(@_);
                   4048:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4049:     return $link;
                   4050: }
                   4051: ##############################################
                   4052: 
                   4053: =pod
                   4054: 
                   4055: =item * &pprmlink()
                   4056: 
                   4057: Inputs: $text $uname $udom $symb $target
                   4058: 
                   4059: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4060: student and a specific resource
1.242     albertel 4061: 
                   4062: =cut
                   4063: 
                   4064: ###############################################
                   4065: sub pprmlink {
                   4066:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4067:     if (!($uname && $udom)) {
                   4068: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4069: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4070: 	if (!$symb) { $symb=$cursymb; }
                   4071:     }
1.254     matthew  4072:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4073:     $symb=&escape($symb);
1.242     albertel 4074:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4075:     return '<a href="/adm/parmset?command=set&amp;'.
                   4076: 	'symb='.$symb.'&amp;uname='.$uname.
                   4077: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4078: }
                   4079: ##############################################
1.37      matthew  4080: 
1.112     bowersj2 4081: =pod
                   4082: 
                   4083: =back
                   4084: 
                   4085: =cut
                   4086: 
1.37      matthew  4087: ###############################################
1.51      www      4088: 
                   4089: 
                   4090: sub timehash {
1.687     raeburn  4091:     my ($thistime) = @_;
                   4092:     my $timezone = &Apache::lonlocal::gettimezone();
                   4093:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4094:                      ->set_time_zone($timezone);
                   4095:     my $wday = $dt->day_of_week();
                   4096:     if ($wday == 7) { $wday = 0; }
                   4097:     return ( 'second' => $dt->second(),
                   4098:              'minute' => $dt->minute(),
                   4099:              'hour'   => $dt->hour(),
                   4100:              'day'     => $dt->day_of_month(),
                   4101:              'month'   => $dt->month(),
                   4102:              'year'    => $dt->year(),
                   4103:              'weekday' => $wday,
                   4104:              'dayyear' => $dt->day_of_year(),
                   4105:              'dlsav'   => $dt->is_dst() );
1.51      www      4106: }
                   4107: 
1.370     www      4108: sub utc_string {
                   4109:     my ($date)=@_;
1.371     www      4110:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4111: }
                   4112: 
1.51      www      4113: sub maketime {
                   4114:     my %th=@_;
1.687     raeburn  4115:     my ($epoch_time,$timezone,$dt);
                   4116:     $timezone = &Apache::lonlocal::gettimezone();
                   4117:     eval {
                   4118:         $dt = DateTime->new( year   => $th{'year'},
                   4119:                              month  => $th{'month'},
                   4120:                              day    => $th{'day'},
                   4121:                              hour   => $th{'hour'},
                   4122:                              minute => $th{'minute'},
                   4123:                              second => $th{'second'},
                   4124:                              time_zone => $timezone,
                   4125:                          );
                   4126:     };
                   4127:     if (!$@) {
                   4128:         $epoch_time = $dt->epoch;
                   4129:         if ($epoch_time) {
                   4130:             return $epoch_time;
                   4131:         }
                   4132:     }
1.51      www      4133:     return POSIX::mktime(
                   4134:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4135:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4136: }
                   4137: 
                   4138: #########################################
1.51      www      4139: 
                   4140: sub findallcourses {
1.482     raeburn  4141:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4142:     my %roles;
                   4143:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4144:     my %courses;
1.51      www      4145:     my $now=time;
1.482     raeburn  4146:     if (!defined($uname)) {
                   4147:         $uname = $env{'user.name'};
                   4148:     }
                   4149:     if (!defined($udom)) {
                   4150:         $udom = $env{'user.domain'};
                   4151:     }
                   4152:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4153:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4154:         if (!%roles) {
                   4155:             %roles = (
                   4156:                        cc => 1,
1.907     raeburn  4157:                        co => 1,
1.482     raeburn  4158:                        in => 1,
                   4159:                        ep => 1,
                   4160:                        ta => 1,
                   4161:                        cr => 1,
                   4162:                        st => 1,
                   4163:              );
                   4164:         }
                   4165:         foreach my $entry (keys(%roleshash)) {
                   4166:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4167:             if ($trole =~ /^cr/) { 
                   4168:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4169:             } else {
                   4170:                 next if (!exists($roles{$trole}));
                   4171:             }
                   4172:             if ($tend) {
                   4173:                 next if ($tend < $now);
                   4174:             }
                   4175:             if ($tstart) {
                   4176:                 next if ($tstart > $now);
                   4177:             }
1.1058    raeburn  4178:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4179:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4180:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4181:             if ($secpart eq '') {
                   4182:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4183:                 $sec = 'none';
1.1058    raeburn  4184:                 $value .= $cnum.'/';
1.482     raeburn  4185:             } else {
                   4186:                 $cnum = $cnumpart;
                   4187:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4188:                 $value .= $cnum.'/'.$sec;
                   4189:             }
                   4190:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4191:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4192:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4193:                 }
                   4194:             } else {
                   4195:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4196:             }
1.482     raeburn  4197:         }
                   4198:     } else {
                   4199:         foreach my $key (keys(%env)) {
1.483     albertel 4200: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4201:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4202: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4203: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4204: 	        next if (%roles && !exists($roles{$role}));
                   4205: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4206:                 my $active=1;
                   4207:                 if ($starttime) {
                   4208: 		    if ($now<$starttime) { $active=0; }
                   4209:                 }
                   4210:                 if ($endtime) {
                   4211:                     if ($now>$endtime) { $active=0; }
                   4212:                 }
                   4213:                 if ($active) {
1.1058    raeburn  4214:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4215:                     if ($sec eq '') {
                   4216:                         $sec = 'none';
1.1058    raeburn  4217:                     } else {
                   4218:                         $value .= $sec;
                   4219:                     }
                   4220:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4221:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4222:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4223:                         }
                   4224:                     } else {
                   4225:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4226:                     }
1.474     raeburn  4227:                 }
                   4228:             }
1.51      www      4229:         }
                   4230:     }
1.474     raeburn  4231:     return %courses;
1.51      www      4232: }
1.37      matthew  4233: 
1.54      www      4234: ###############################################
1.474     raeburn  4235: 
                   4236: sub blockcheck {
1.1062    raeburn  4237:     my ($setters,$activity,$uname,$udom,$url) = @_;
1.490     raeburn  4238: 
                   4239:     if (!defined($udom)) {
                   4240:         $udom = $env{'user.domain'};
                   4241:     }
                   4242:     if (!defined($uname)) {
                   4243:         $uname = $env{'user.name'};
                   4244:     }
                   4245: 
                   4246:     # If uname and udom are for a course, check for blocks in the course.
                   4247: 
                   4248:     if (&Apache::lonnet::is_course($udom,$uname)) {
1.1062    raeburn  4249:         my ($startblock,$endblock,$triggerblock) = 
                   4250:             &get_blocks($setters,$activity,$udom,$uname,$url);
                   4251:         return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4252:     }
1.474     raeburn  4253: 
1.502     raeburn  4254:     my $startblock = 0;
                   4255:     my $endblock = 0;
1.1062    raeburn  4256:     my $triggerblock = '';
1.482     raeburn  4257:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4258: 
1.490     raeburn  4259:     # If uname is for a user, and activity is course-specific, i.e.,
                   4260:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4261: 
1.490     raeburn  4262:     if (($activity eq 'boards' || $activity eq 'chat' ||
                   4263:          $activity eq 'groups') && ($env{'request.course.id'})) {
                   4264:         foreach my $key (keys(%live_courses)) {
                   4265:             if ($key ne $env{'request.course.id'}) {
                   4266:                 delete($live_courses{$key});
                   4267:             }
                   4268:         }
                   4269:     }
                   4270: 
                   4271:     my $otheruser = 0;
                   4272:     my %own_courses;
                   4273:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4274:         # Resource belongs to user other than current user.
                   4275:         $otheruser = 1;
                   4276:         # Gather courses for current user
                   4277:         %own_courses = 
                   4278:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4279:     }
                   4280: 
                   4281:     # Gather active course roles - course coordinator, instructor, 
                   4282:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4283: 
                   4284:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4285:         my ($cdom,$cnum);
                   4286:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4287:             $cdom = $env{'course.'.$course.'.domain'};
                   4288:             $cnum = $env{'course.'.$course.'.num'};
                   4289:         } else {
1.490     raeburn  4290:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4291:         }
                   4292:         my $no_ownblock = 0;
                   4293:         my $no_userblock = 0;
1.533     raeburn  4294:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4295:             # Check if current user has 'evb' priv for this
                   4296:             if (defined($own_courses{$course})) {
                   4297:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4298:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4299:                     if ($sec ne 'none') {
                   4300:                         $checkrole .= '/'.$sec;
                   4301:                     }
                   4302:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4303:                         $no_ownblock = 1;
                   4304:                         last;
                   4305:                     }
                   4306:                 }
                   4307:             }
                   4308:             # if they have 'evb' priv and are currently not playing student
                   4309:             next if (($no_ownblock) &&
                   4310:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4311:         }
1.474     raeburn  4312:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4313:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4314:             if ($sec ne 'none') {
1.482     raeburn  4315:                 $checkrole .= '/'.$sec;
1.474     raeburn  4316:             }
1.490     raeburn  4317:             if ($otheruser) {
                   4318:                 # Resource belongs to user other than current user.
                   4319:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4320:                 my (%allroles,%userroles);
                   4321:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4322:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4323:                         my ($trole,$tdom,$tnum,$tsec);
                   4324:                         if ($entry =~ /^cr/) {
                   4325:                             ($trole,$tdom,$tnum,$tsec) = 
                   4326:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4327:                         } else {
                   4328:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4329:                         }
                   4330:                         my ($spec,$area,$trest);
                   4331:                         $area = '/'.$tdom.'/'.$tnum;
                   4332:                         $trest = $tnum;
                   4333:                         if ($tsec ne '') {
                   4334:                             $area .= '/'.$tsec;
                   4335:                             $trest .= '/'.$tsec;
                   4336:                         }
                   4337:                         $spec = $trole.'.'.$area;
                   4338:                         if ($trole =~ /^cr/) {
                   4339:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4340:                                                               $tdom,$spec,$trest,$area);
                   4341:                         } else {
                   4342:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4343:                                                                 $tdom,$spec,$trest,$area);
                   4344:                         }
                   4345:                     }
                   4346:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4347:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4348:                         if ($1) {
                   4349:                             $no_userblock = 1;
                   4350:                             last;
                   4351:                         }
1.486     raeburn  4352:                     }
                   4353:                 }
1.490     raeburn  4354:             } else {
                   4355:                 # Resource belongs to current user
                   4356:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4357:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4358:                     $no_ownblock = 1;
                   4359:                     last;
                   4360:                 }
1.474     raeburn  4361:             }
                   4362:         }
                   4363:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4364:         next if (($no_ownblock) &&
1.491     albertel 4365:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4366:         next if ($no_userblock);
1.474     raeburn  4367: 
1.866     kalberla 4368:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4369:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4370:         
1.1062    raeburn  4371:         my ($start,$end,$trigger) = 
                   4372:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4373:         if (($start != 0) && 
                   4374:             (($startblock == 0) || ($startblock > $start))) {
                   4375:             $startblock = $start;
1.1062    raeburn  4376:             if ($trigger ne '') {
                   4377:                 $triggerblock = $trigger;
                   4378:             }
1.502     raeburn  4379:         }
                   4380:         if (($end != 0)  &&
                   4381:             (($endblock == 0) || ($endblock < $end))) {
                   4382:             $endblock = $end;
1.1062    raeburn  4383:             if ($trigger ne '') {
                   4384:                 $triggerblock = $trigger;
                   4385:             }
1.502     raeburn  4386:         }
1.490     raeburn  4387:     }
1.1062    raeburn  4388:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4389: }
                   4390: 
                   4391: sub get_blocks {
1.1062    raeburn  4392:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4393:     my $startblock = 0;
                   4394:     my $endblock = 0;
1.1062    raeburn  4395:     my $triggerblock = '';
1.490     raeburn  4396:     my $course = $cdom.'_'.$cnum;
                   4397:     $setters->{$course} = {};
                   4398:     $setters->{$course}{'staff'} = [];
                   4399:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4400:     $setters->{$course}{'triggers'} = [];
                   4401:     my (@blockers,%triggered);
                   4402:     my $now = time;
                   4403:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4404:     if ($activity eq 'docs') {
                   4405:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4406:         foreach my $block (@blockers) {
                   4407:             if ($block =~ /^firstaccess____(.+)$/) {
                   4408:                 my $item = $1;
                   4409:                 my $type = 'map';
                   4410:                 my $timersymb = $item;
                   4411:                 if ($item eq 'course') {
                   4412:                     $type = 'course';
                   4413:                 } elsif ($item =~ /___\d+___/) {
                   4414:                     $type = 'resource';
                   4415:                 } else {
                   4416:                     $timersymb = &Apache::lonnet::symbread($item);
                   4417:                 }
                   4418:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4419:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4420:                 $triggered{$block} = {
                   4421:                                        start => $start,
                   4422:                                        end   => $end,
                   4423:                                        type  => $type,
                   4424:                                      };
                   4425:             }
                   4426:         }
                   4427:     } else {
                   4428:         foreach my $block (keys(%commblocks)) {
                   4429:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4430:                 my ($start,$end) = ($1,$2);
                   4431:                 if ($start <= time && $end >= time) {
                   4432:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4433:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4434:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4435:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4436:                                     push(@blockers,$block);
                   4437:                                 }
                   4438:                             }
                   4439:                         }
                   4440:                     }
                   4441:                 }
                   4442:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4443:                 my $item = $1;
                   4444:                 my $timersymb = $item; 
                   4445:                 my $type = 'map';
                   4446:                 if ($item eq 'course') {
                   4447:                     $type = 'course';
                   4448:                 } elsif ($item =~ /___\d+___/) {
                   4449:                     $type = 'resource';
                   4450:                 } else {
                   4451:                     $timersymb = &Apache::lonnet::symbread($item);
                   4452:                 }
                   4453:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4454:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4455:                 if ($start && $end) {
                   4456:                     if (($start <= time) && ($end >= time)) {
                   4457:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4458:                             push(@blockers,$block);
                   4459:                             $triggered{$block} = {
                   4460:                                                    start => $start,
                   4461:                                                    end   => $end,
                   4462:                                                    type  => $type,
                   4463:                                                  };
                   4464:                         }
                   4465:                     }
1.490     raeburn  4466:                 }
1.1062    raeburn  4467:             }
                   4468:         }
                   4469:     }
                   4470:     foreach my $blocker (@blockers) {
                   4471:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4472:             &parse_block_record($commblocks{$blocker});
                   4473:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4474:         my ($start,$end,$triggertype);
                   4475:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4476:             ($start,$end) = ($1,$2);
                   4477:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4478:             $start = $triggered{$blocker}{'start'};
                   4479:             $end = $triggered{$blocker}{'end'};
                   4480:             $triggertype = $triggered{$blocker}{'type'};
                   4481:         }
                   4482:         if ($start) {
                   4483:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4484:             if ($triggertype) {
                   4485:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4486:             } else {
                   4487:                 push(@{$$setters{$course}{'triggers'}},0);
                   4488:             }
                   4489:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4490:                 $startblock = $start;
                   4491:                 if ($triggertype) {
                   4492:                     $triggerblock = $blocker;
1.474     raeburn  4493:                 }
                   4494:             }
1.1062    raeburn  4495:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4496:                $endblock = $end;
                   4497:                if ($triggertype) {
                   4498:                    $triggerblock = $blocker;
                   4499:                }
                   4500:             }
1.474     raeburn  4501:         }
                   4502:     }
1.1062    raeburn  4503:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4504: }
                   4505: 
                   4506: sub parse_block_record {
                   4507:     my ($record) = @_;
                   4508:     my ($setuname,$setudom,$title,$blocks);
                   4509:     if (ref($record) eq 'HASH') {
                   4510:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4511:         $title = &unescape($record->{'event'});
                   4512:         $blocks = $record->{'blocks'};
                   4513:     } else {
                   4514:         my @data = split(/:/,$record,3);
                   4515:         if (scalar(@data) eq 2) {
                   4516:             $title = $data[1];
                   4517:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4518:         } else {
                   4519:             ($setuname,$setudom,$title) = @data;
                   4520:         }
                   4521:         $blocks = { 'com' => 'on' };
                   4522:     }
                   4523:     return ($setuname,$setudom,$title,$blocks);
                   4524: }
                   4525: 
1.854     kalberla 4526: sub blocking_status {
1.1062    raeburn  4527:     my ($activity,$uname,$udom,$url) = @_;
1.1061    raeburn  4528:     my %setters;
1.890     droeschl 4529: 
1.1061    raeburn  4530: # check for active blocking
1.1062    raeburn  4531:     my ($startblock,$endblock,$triggerblock) = 
                   4532:         &blockcheck(\%setters,$activity,$uname,$udom,$url);
                   4533:     my $blocked = 0;
                   4534:     if ($startblock && $endblock) {
                   4535:         $blocked = 1;
                   4536:     }
1.890     droeschl 4537: 
1.1061    raeburn  4538: # caller just wants to know whether a block is active
                   4539:     if (!wantarray) { return $blocked; }
                   4540: 
                   4541: # build a link to a popup window containing the details
                   4542:     my $querystring  = "?activity=$activity";
                   4543: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4544:     if ($activity eq 'port') {
                   4545:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4546:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4547:     } elsif ($activity eq 'docs') {
                   4548:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4549:     }
1.1061    raeburn  4550: 
                   4551:     my $output .= <<'END_MYBLOCK';
                   4552: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4553:     var options = "width=" + w + ",height=" + h + ",";
                   4554:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4555:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4556:     var newWin = window.open(url, wdwName, options);
                   4557:     newWin.focus();
                   4558: }
1.890     droeschl 4559: END_MYBLOCK
1.854     kalberla 4560: 
1.1061    raeburn  4561:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4562:   
1.1061    raeburn  4563:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4564:     my $text = &mt('Communication Blocked');
                   4565:     if ($activity eq 'docs') {
                   4566:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4567:     } elsif ($activity eq 'printout') {
                   4568:         $text = &mt('Printing Blocked');
1.1062    raeburn  4569:     }
1.1061    raeburn  4570:     $output .= <<"END_BLOCK";
1.867     kalberla 4571: <div class='LC_comblock'>
1.869     kalberla 4572:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4573:   title='$text'>
                   4574:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4575:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4576:   title='$text'>$text</a>
1.867     kalberla 4577: </div>
                   4578: 
                   4579: END_BLOCK
1.474     raeburn  4580: 
1.1061    raeburn  4581:     return ($blocked, $output);
1.854     kalberla 4582: }
1.490     raeburn  4583: 
1.60      matthew  4584: ###############################################
                   4585: 
1.682     raeburn  4586: sub check_ip_acc {
                   4587:     my ($acc)=@_;
                   4588:     &Apache::lonxml::debug("acc is $acc");
                   4589:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4590:         return 1;
                   4591:     }
                   4592:     my $allowed=0;
                   4593:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4594: 
                   4595:     my $name;
                   4596:     foreach my $pattern (split(',',$acc)) {
                   4597:         $pattern =~ s/^\s*//;
                   4598:         $pattern =~ s/\s*$//;
                   4599:         if ($pattern =~ /\*$/) {
                   4600:             #35.8.*
                   4601:             $pattern=~s/\*//;
                   4602:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4603:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4604:             #35.8.3.[34-56]
                   4605:             my $low=$2;
                   4606:             my $high=$3;
                   4607:             $pattern=$1;
                   4608:             if ($ip =~ /^\Q$pattern\E/) {
                   4609:                 my $last=(split(/\./,$ip))[3];
                   4610:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4611:             }
                   4612:         } elsif ($pattern =~ /^\*/) {
                   4613:             #*.msu.edu
                   4614:             $pattern=~s/\*//;
                   4615:             if (!defined($name)) {
                   4616:                 use Socket;
                   4617:                 my $netaddr=inet_aton($ip);
                   4618:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4619:             }
                   4620:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4621:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4622:             #127.0.0.1
                   4623:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4624:         } else {
                   4625:             #some.name.com
                   4626:             if (!defined($name)) {
                   4627:                 use Socket;
                   4628:                 my $netaddr=inet_aton($ip);
                   4629:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4630:             }
                   4631:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4632:         }
                   4633:         if ($allowed) { last; }
                   4634:     }
                   4635:     return $allowed;
                   4636: }
                   4637: 
                   4638: ###############################################
                   4639: 
1.60      matthew  4640: =pod
                   4641: 
1.112     bowersj2 4642: =head1 Domain Template Functions
                   4643: 
                   4644: =over 4
                   4645: 
                   4646: =item * &determinedomain()
1.60      matthew  4647: 
                   4648: Inputs: $domain (usually will be undef)
                   4649: 
1.63      www      4650: Returns: Determines which domain should be used for designs
1.60      matthew  4651: 
                   4652: =cut
1.54      www      4653: 
1.60      matthew  4654: ###############################################
1.63      www      4655: sub determinedomain {
                   4656:     my $domain=shift;
1.531     albertel 4657:     if (! $domain) {
1.60      matthew  4658:         # Determine domain if we have not been given one
1.893     raeburn  4659:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4660:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4661:         if ($env{'request.role.domain'}) { 
                   4662:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4663:         }
                   4664:     }
1.63      www      4665:     return $domain;
                   4666: }
                   4667: ###############################################
1.517     raeburn  4668: 
1.518     albertel 4669: sub devalidate_domconfig_cache {
                   4670:     my ($udom)=@_;
                   4671:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4672: }
                   4673: 
                   4674: # ---------------------- Get domain configuration for a domain
                   4675: sub get_domainconf {
                   4676:     my ($udom) = @_;
                   4677:     my $cachetime=1800;
                   4678:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4679:     if (defined($cached)) { return %{$result}; }
                   4680: 
                   4681:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4682: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4683:     my (%designhash,%legacy);
1.518     albertel 4684:     if (keys(%domconfig) > 0) {
                   4685:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4686:             if (keys(%{$domconfig{'login'}})) {
                   4687:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4688:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4689:                         if ($key eq 'loginvia') {
                   4690:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4691:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4692:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4693:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4694:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4695:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4696:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4697: 
                   4698:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4699:                                             } else {
1.1013    raeburn  4700:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4701:                                             }
                   4702:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4703:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4704:                                             }
1.946     raeburn  4705:                                         }
                   4706:                                     }
                   4707:                                 }
                   4708:                             }
                   4709:                         } else {
                   4710:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4711:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4712:                                     $domconfig{'login'}{$key}{$img};
                   4713:                             }
1.699     raeburn  4714:                         }
                   4715:                     } else {
                   4716:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4717:                     }
1.632     raeburn  4718:                 }
                   4719:             } else {
                   4720:                 $legacy{'login'} = 1;
1.518     albertel 4721:             }
1.632     raeburn  4722:         } else {
                   4723:             $legacy{'login'} = 1;
1.518     albertel 4724:         }
                   4725:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4726:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4727:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4728:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4729:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4730:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4731:                         }
1.518     albertel 4732:                     }
                   4733:                 }
1.632     raeburn  4734:             } else {
                   4735:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4736:             }
1.632     raeburn  4737:         } else {
                   4738:             $legacy{'rolecolors'} = 1;
1.518     albertel 4739:         }
1.948     raeburn  4740:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4741:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4742:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4743:             }
                   4744:         }
1.632     raeburn  4745:         if (keys(%legacy) > 0) {
                   4746:             my %legacyhash = &get_legacy_domconf($udom);
                   4747:             foreach my $item (keys(%legacyhash)) {
                   4748:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4749:                     if ($legacy{'login'}) { 
                   4750:                         $designhash{$item} = $legacyhash{$item};
                   4751:                     }
                   4752:                 } else {
                   4753:                     if ($legacy{'rolecolors'}) {
                   4754:                         $designhash{$item} = $legacyhash{$item};
                   4755:                     }
1.518     albertel 4756:                 }
                   4757:             }
                   4758:         }
1.632     raeburn  4759:     } else {
                   4760:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4761:     }
                   4762:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4763: 				  $cachetime);
                   4764:     return %designhash;
                   4765: }
                   4766: 
1.632     raeburn  4767: sub get_legacy_domconf {
                   4768:     my ($udom) = @_;
                   4769:     my %legacyhash;
                   4770:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4771:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4772:     if (-e $designfile) {
                   4773:         if ( open (my $fh,"<$designfile") ) {
                   4774:             while (my $line = <$fh>) {
                   4775:                 next if ($line =~ /^\#/);
                   4776:                 chomp($line);
                   4777:                 my ($key,$val)=(split(/\=/,$line));
                   4778:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4779:             }
                   4780:             close($fh);
                   4781:         }
                   4782:     }
1.1026    raeburn  4783:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4784:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4785:     }
                   4786:     return %legacyhash;
                   4787: }
                   4788: 
1.63      www      4789: =pod
                   4790: 
1.112     bowersj2 4791: =item * &domainlogo()
1.63      www      4792: 
                   4793: Inputs: $domain (usually will be undef)
                   4794: 
                   4795: Returns: A link to a domain logo, if the domain logo exists.
                   4796: If the domain logo does not exist, a description of the domain.
                   4797: 
                   4798: =cut
1.112     bowersj2 4799: 
1.63      www      4800: ###############################################
                   4801: sub domainlogo {
1.517     raeburn  4802:     my $domain = &determinedomain(shift);
1.518     albertel 4803:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4804:     # See if there is a logo
                   4805:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4806:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4807:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4808: 	    if ($imgsrc =~ m{^/res/}) {
                   4809: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4810: 		&Apache::lonnet::repcopy($local_name);
                   4811: 	    }
                   4812: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4813:         } 
                   4814:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4815:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4816:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4817:     } else {
1.60      matthew  4818:         return '';
1.59      www      4819:     }
                   4820: }
1.63      www      4821: ##############################################
                   4822: 
                   4823: =pod
                   4824: 
1.112     bowersj2 4825: =item * &designparm()
1.63      www      4826: 
                   4827: Inputs: $which parameter; $domain (usually will be undef)
                   4828: 
                   4829: Returns: value of designparamter $which
                   4830: 
                   4831: =cut
1.112     bowersj2 4832: 
1.397     albertel 4833: 
1.400     albertel 4834: ##############################################
1.397     albertel 4835: sub designparm {
                   4836:     my ($which,$domain)=@_;
                   4837:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4838:         return $env{'environment.color.'.$which};
1.96      www      4839:     }
1.63      www      4840:     $domain=&determinedomain($domain);
1.1016    raeburn  4841:     my %domdesign;
                   4842:     unless ($domain eq 'public') {
                   4843:         %domdesign = &get_domainconf($domain);
                   4844:     }
1.520     raeburn  4845:     my $output;
1.517     raeburn  4846:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4847:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4848:     } else {
1.520     raeburn  4849:         $output = $defaultdesign{$which};
                   4850:     }
                   4851:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4852:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4853:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4854:             if ($output =~ m{^/res/}) {
                   4855:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4856:                 &Apache::lonnet::repcopy($local_name);
                   4857:             }
1.520     raeburn  4858:             $output = &lonhttpdurl($output);
                   4859:         }
1.63      www      4860:     }
1.520     raeburn  4861:     return $output;
1.63      www      4862: }
1.59      www      4863: 
1.822     bisitz   4864: ##############################################
                   4865: =pod
                   4866: 
1.832     bisitz   4867: =item * &authorspace()
                   4868: 
1.1028    raeburn  4869: Inputs: $url (usually will be undef).
1.832     bisitz   4870: 
1.1075.2.40  raeburn  4871: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  4872:          directory being viewed (or for which action is being taken). 
                   4873:          If $url is provided, and begins /priv/<domain>/<uname>
                   4874:          the path will be that portion of the $context argument.
                   4875:          Otherwise the path will be for the author space of the current
                   4876:          user when the current role is author, or for that of the 
                   4877:          co-author/assistant co-author space when the current role 
                   4878:          is co-author or assistant co-author.
1.832     bisitz   4879: 
                   4880: =cut
                   4881: 
                   4882: sub authorspace {
1.1028    raeburn  4883:     my ($url) = @_;
                   4884:     if ($url ne '') {
                   4885:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4886:            return $1;
                   4887:         }
                   4888:     }
1.832     bisitz   4889:     my $caname = '';
1.1024    www      4890:     my $cadom = '';
1.1028    raeburn  4891:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4892:         ($cadom,$caname) =
1.832     bisitz   4893:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4894:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4895:         $caname = $env{'user.name'};
1.1024    www      4896:         $cadom = $env{'user.domain'};
1.832     bisitz   4897:     }
1.1028    raeburn  4898:     if (($caname ne '') && ($cadom ne '')) {
                   4899:         return "/priv/$cadom/$caname/";
                   4900:     }
                   4901:     return;
1.832     bisitz   4902: }
                   4903: 
                   4904: ##############################################
                   4905: =pod
                   4906: 
1.822     bisitz   4907: =item * &head_subbox()
                   4908: 
                   4909: Inputs: $content (contains HTML code with page functions, etc.)
                   4910: 
                   4911: Returns: HTML div with $content
                   4912:          To be included in page header
                   4913: 
                   4914: =cut
                   4915: 
                   4916: sub head_subbox {
                   4917:     my ($content)=@_;
                   4918:     my $output =
1.993     raeburn  4919:         '<div class="LC_head_subbox">'
1.822     bisitz   4920:        .$content
                   4921:        .'</div>'
                   4922: }
                   4923: 
                   4924: ##############################################
                   4925: =pod
                   4926: 
                   4927: =item * &CSTR_pageheader()
                   4928: 
1.1026    raeburn  4929: Input: (optional) filename from which breadcrumb trail is built.
                   4930:        In most cases no input as needed, as $env{'request.filename'}
                   4931:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4932: 
                   4933: Returns: HTML div with CSTR path and recent box
1.1075.2.40  raeburn  4934:          To be included on Authoring Space pages
1.822     bisitz   4935: 
                   4936: =cut
                   4937: 
                   4938: sub CSTR_pageheader {
1.1026    raeburn  4939:     my ($trailfile) = @_;
                   4940:     if ($trailfile eq '') {
                   4941:         $trailfile = $env{'request.filename'};
                   4942:     }
                   4943: 
                   4944: # this is for resources; directories have customtitle, and crumbs
                   4945: # and select recent are created in lonpubdir.pm
                   4946: 
                   4947:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4948:     my ($udom,$uname,$thisdisfn)=
1.1075.2.29  raeburn  4949:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  4950:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4951:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4952: 
                   4953:     my $parentpath = '';
                   4954:     my $lastitem = '';
                   4955:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4956:         $parentpath = $1;
                   4957:         $lastitem = $2;
                   4958:     } else {
                   4959:         $lastitem = $thisdisfn;
                   4960:     }
1.921     bisitz   4961: 
                   4962:     my $output =
1.822     bisitz   4963:          '<div>'
                   4964:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40  raeburn  4965:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   4966:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4967:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4968:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4969: 
                   4970:     if ($lastitem) {
                   4971:         $output .=
                   4972:              '<span class="LC_filename">'
                   4973:             .$lastitem
                   4974:             .'</span>';
                   4975:     }
                   4976:     $output .=
                   4977:          '<br />'
1.822     bisitz   4978:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4979:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4980:         .'</form>'
                   4981:         .&Apache::lonmenu::constspaceform()
                   4982:         .'</div>';
1.921     bisitz   4983: 
                   4984:     return $output;
1.822     bisitz   4985: }
                   4986: 
1.60      matthew  4987: ###############################################
                   4988: ###############################################
                   4989: 
                   4990: =pod
                   4991: 
1.112     bowersj2 4992: =back
                   4993: 
1.549     albertel 4994: =head1 HTML Helpers
1.112     bowersj2 4995: 
                   4996: =over 4
                   4997: 
                   4998: =item * &bodytag()
1.60      matthew  4999: 
                   5000: Returns a uniform header for LON-CAPA web pages.
                   5001: 
                   5002: Inputs: 
                   5003: 
1.112     bowersj2 5004: =over 4
                   5005: 
                   5006: =item * $title, A title to be displayed on the page.
                   5007: 
                   5008: =item * $function, the current role (can be undef).
                   5009: 
                   5010: =item * $addentries, extra parameters for the <body> tag.
                   5011: 
                   5012: =item * $bodyonly, if defined, only return the <body> tag.
                   5013: 
                   5014: =item * $domain, if defined, force a given domain.
                   5015: 
                   5016: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5017:             text interface only)
1.60      matthew  5018: 
1.814     bisitz   5019: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5020:                      navigational links
1.317     albertel 5021: 
1.338     albertel 5022: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5023: 
1.1075.2.12  raeburn  5024: =item * $no_inline_link, if true and in remote mode, don't show the
                   5025:          'Switch To Inline Menu' link
                   5026: 
1.460     albertel 5027: =item * $args, optional argument valid values are
                   5028:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5029:             inherit_jsmath -> when creating popup window in a page,
                   5030:                               should it have jsmath forced on by the
                   5031:                               current page
1.460     albertel 5032: 
1.1075.2.15  raeburn  5033: =item * $advtoolsref, optional argument, ref to an array containing
                   5034:             inlineremote items to be added in "Functions" menu below
                   5035:             breadcrumbs.
                   5036: 
1.112     bowersj2 5037: =back
                   5038: 
1.60      matthew  5039: Returns: A uniform header for LON-CAPA web pages.  
                   5040: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5041: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5042: other decorations will be returned.
                   5043: 
                   5044: =cut
                   5045: 
1.54      www      5046: sub bodytag {
1.831     bisitz   5047:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15  raeburn  5048:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 5049: 
1.954     raeburn  5050:     my $public;
                   5051:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5052:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5053:         $public = 1;
                   5054:     }
1.460     albertel 5055:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52  raeburn  5056:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5057: 
1.183     matthew  5058:     $function = &get_users_function() if (!$function);
1.339     albertel 5059:     my $img =    &designparm($function.'.img',$domain);
                   5060:     my $font =   &designparm($function.'.font',$domain);
                   5061:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5062: 
1.803     bisitz   5063:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5064: 		   'bgcolor' => $pgbg,
1.339     albertel 5065: 		   'text'    => $font,
                   5066:                    'alink'   => &designparm($function.'.alink',$domain),
                   5067: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5068: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5069:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5070: 
1.63      www      5071:  # role and realm
1.1075.2.68  raeburn  5072:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5073:     if ($realm) {
                   5074:         $realm = '/'.$realm;
                   5075:     }
1.378     raeburn  5076:     if ($role  eq 'ca') {
1.479     albertel 5077:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5078:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5079:     } 
1.55      www      5080: # realm
1.258     albertel 5081:     if ($env{'request.course.id'}) {
1.378     raeburn  5082:         if ($env{'request.role'} !~ /^cr/) {
                   5083:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5084:         }
1.898     raeburn  5085:         if ($env{'request.course.sec'}) {
                   5086:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5087:         }   
1.359     albertel 5088: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5089:     } else {
                   5090:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5091:     }
1.433     albertel 5092: 
1.359     albertel 5093:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5094: 
1.438     albertel 5095:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5096: 
1.101     www      5097: # construct main body tag
1.359     albertel 5098:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5099: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5100: 
1.1075.2.38  raeburn  5101:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5102: 
                   5103:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5104:         return $bodytag;
1.1075.2.38  raeburn  5105:     }
1.359     albertel 5106: 
1.954     raeburn  5107:     if ($public) {
1.433     albertel 5108: 	undef($role);
                   5109:     }
1.359     albertel 5110:     
1.762     bisitz   5111:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5112:     #
                   5113:     # Extra info if you are the DC
                   5114:     my $dc_info = '';
                   5115:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5116:                         $env{'course.'.$env{'request.course.id'}.
                   5117:                                  '.domain'}.'/'})) {
                   5118:         my $cid = $env{'request.course.id'};
1.917     raeburn  5119:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5120:         $dc_info =~ s/\s+$//;
1.359     albertel 5121:     }
                   5122: 
1.898     raeburn  5123:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903     droeschl 5124: 
1.1075.2.13  raeburn  5125:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5126: 
1.1075.2.38  raeburn  5127: 
                   5128: 
1.1075.2.21  raeburn  5129:     my $funclist;
                   5130:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52  raeburn  5131:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21  raeburn  5132:                     Apache::lonmenu::serverform();
                   5133:         my $forbodytag;
                   5134:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5135:                                             $forcereg,$args->{'group'},
                   5136:                                             $args->{'bread_crumbs'},
                   5137:                                             $advtoolsref,'',\$forbodytag);
                   5138:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5139:             $funclist = $forbodytag;
                   5140:         }
                   5141:     } else {
1.903     droeschl 5142: 
                   5143:         #    if ($env{'request.state'} eq 'construct') {
                   5144:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5145:         #    }
                   5146: 
1.1075.2.38  raeburn  5147:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5148:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5149: 
1.1075.2.38  raeburn  5150:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2  raeburn  5151: 
1.916     droeschl 5152:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22  raeburn  5153:             if ($dc_info) {
                   5154:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5155:             }
1.1075.2.38  raeburn  5156:             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22  raeburn  5157:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5158:             return $bodytag;
                   5159:         }
1.894     droeschl 5160: 
1.927     raeburn  5161:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38  raeburn  5162:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5163:         }
1.916     droeschl 5164: 
1.1075.2.38  raeburn  5165:         $bodytag .= $right;
1.852     droeschl 5166: 
1.917     raeburn  5167:         if ($dc_info) {
                   5168:             $dc_info = &dc_courseid_toggle($dc_info);
                   5169:         }
                   5170:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5171: 
1.1075.2.61  raeburn  5172:         #if directed to not display the secondary menu, don't.
                   5173:         if ($args->{'no_secondary_menu'}) {
                   5174:             return $bodytag;
                   5175:         }
1.903     droeschl 5176:         #don't show menus for public users
1.954     raeburn  5177:         if (!$public){
1.1075.2.52  raeburn  5178:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5179:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5180:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5181:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5182:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5183:                                 $args->{'bread_crumbs'});
                   5184:             } elsif ($forcereg) { 
1.1075.2.22  raeburn  5185:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5186:                                                             $args->{'group'});
1.1075.2.15  raeburn  5187:             } else {
1.1075.2.21  raeburn  5188:                 my $forbodytag;
                   5189:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5190:                                                     $forcereg,$args->{'group'},
                   5191:                                                     $args->{'bread_crumbs'},
                   5192:                                                     $advtoolsref,'',\$forbodytag);
                   5193:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5194:                     $bodytag .= $forbodytag;
                   5195:                 }
1.920     raeburn  5196:             }
1.903     droeschl 5197:         }else{
                   5198:             # this is to seperate menu from content when there's no secondary
                   5199:             # menu. Especially needed for public accessible ressources.
                   5200:             $bodytag .= '<hr style="clear:both" />';
                   5201:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5202:         }
1.903     droeschl 5203: 
1.235     raeburn  5204:         return $bodytag;
1.1075.2.12  raeburn  5205:     }
                   5206: 
                   5207: #
                   5208: # Top frame rendering, Remote is up
                   5209: #
                   5210: 
                   5211:     my $imgsrc = $img;
                   5212:     if ($img =~ /^\/adm/) {
                   5213:         $imgsrc = &lonhttpdurl($img);
                   5214:     }
                   5215:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5216: 
1.1075.2.60  raeburn  5217:     my $help=($no_inline_link?''
                   5218:               :&Apache::loncommon::top_nav_help('Help'));
                   5219: 
1.1075.2.12  raeburn  5220:     # Explicit link to get inline menu
                   5221:     my $menu= ($no_inline_link?''
                   5222:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5223: 
                   5224:     if ($dc_info) {
                   5225:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5226:     }
                   5227: 
1.1075.2.38  raeburn  5228:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
                   5229:     unless ($public) {
                   5230:         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5231:                                 undef,'LC_menubuttons_link');
                   5232:     }
                   5233: 
1.1075.2.12  raeburn  5234:     unless ($env{'form.inhibitmenu'}) {
                   5235:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38  raeburn  5236:                        <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60  raeburn  5237:                        <li>$help</li>
1.1075.2.12  raeburn  5238:                        <li>$menu</li>
                   5239:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5240:     }
1.1075.2.13  raeburn  5241:     if ($env{'request.state'} eq 'construct') {
                   5242:         if (!$public){
                   5243:             if ($env{'request.state'} eq 'construct') {
                   5244:                 $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5245:                                 &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13  raeburn  5246:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5247:                             &Apache::lonmenu::innerregister($forcereg,
                   5248:                                                             $args->{'bread_crumbs'});
                   5249:             }
                   5250:         }
                   5251:     }
1.1075.2.21  raeburn  5252:     return $bodytag."\n".$funclist;
1.182     matthew  5253: }
                   5254: 
1.917     raeburn  5255: sub dc_courseid_toggle {
                   5256:     my ($dc_info) = @_;
1.980     raeburn  5257:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5258:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5259:            &mt('(More ...)').'</a></span>'.
                   5260:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5261: }
                   5262: 
1.330     albertel 5263: sub make_attr_string {
                   5264:     my ($register,$attr_ref) = @_;
                   5265: 
                   5266:     if ($attr_ref && !ref($attr_ref)) {
                   5267: 	die("addentries Must be a hash ref ".
                   5268: 	    join(':',caller(1))." ".
                   5269: 	    join(':',caller(0))." ");
                   5270:     }
                   5271: 
                   5272:     if ($register) {
1.339     albertel 5273: 	my ($on_load,$on_unload);
                   5274: 	foreach my $key (keys(%{$attr_ref})) {
                   5275: 	    if      (lc($key) eq 'onload') {
                   5276: 		$on_load.=$attr_ref->{$key}.';';
                   5277: 		delete($attr_ref->{$key});
                   5278: 
                   5279: 	    } elsif (lc($key) eq 'onunload') {
                   5280: 		$on_unload.=$attr_ref->{$key}.';';
                   5281: 		delete($attr_ref->{$key});
                   5282: 	    }
                   5283: 	}
1.1075.2.12  raeburn  5284:         if ($env{'environment.remote'} eq 'on') {
                   5285:             $attr_ref->{'onload'}  =
                   5286:                 &Apache::lonmenu::loadevents().  $on_load;
                   5287:             $attr_ref->{'onunload'}=
                   5288:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5289:         } else {  
                   5290: 	    $attr_ref->{'onload'}  = $on_load;
                   5291: 	    $attr_ref->{'onunload'}= $on_unload;
                   5292:         }
1.330     albertel 5293:     }
1.339     albertel 5294: 
1.330     albertel 5295:     my $attr_string;
1.1075.2.56  raeburn  5296:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5297: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5298:     }
                   5299:     return $attr_string;
                   5300: }
                   5301: 
                   5302: 
1.182     matthew  5303: ###############################################
1.251     albertel 5304: ###############################################
                   5305: 
                   5306: =pod
                   5307: 
                   5308: =item * &endbodytag()
                   5309: 
                   5310: Returns a uniform footer for LON-CAPA web pages.
                   5311: 
1.635     raeburn  5312: Inputs: 1 - optional reference to an args hash
                   5313: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5314: a 'Continue' link is not displayed if the page contains an
                   5315: internal redirect in the <head></head> section,
                   5316: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5317: 
                   5318: =cut
                   5319: 
                   5320: sub endbodytag {
1.635     raeburn  5321:     my ($args) = @_;
1.1075.2.6  raeburn  5322:     my $endbodytag;
                   5323:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5324:         $endbodytag='</body>';
                   5325:     }
1.269     albertel 5326:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5327:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5328:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5329: 	    $endbodytag=
                   5330: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5331: 	        &mt('Continue').'</a>'.
                   5332: 	        $endbodytag;
                   5333:         }
1.315     albertel 5334:     }
1.251     albertel 5335:     return $endbodytag;
                   5336: }
                   5337: 
1.352     albertel 5338: =pod
                   5339: 
                   5340: =item * &standard_css()
                   5341: 
                   5342: Returns a style sheet
                   5343: 
                   5344: Inputs: (all optional)
                   5345:             domain         -> force to color decorate a page for a specific
                   5346:                                domain
                   5347:             function       -> force usage of a specific rolish color scheme
                   5348:             bgcolor        -> override the default page bgcolor
                   5349: 
                   5350: =cut
                   5351: 
1.343     albertel 5352: sub standard_css {
1.345     albertel 5353:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5354:     $function  = &get_users_function() if (!$function);
                   5355:     my $img    = &designparm($function.'.img',   $domain);
                   5356:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5357:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5358:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5359: #second colour for later usage
1.345     albertel 5360:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5361:     my $pgbg_or_bgcolor =
                   5362: 	         $bgcolor ||
1.352     albertel 5363: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5364:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5365:     my $alink  = &designparm($function.'.alink', $domain);
                   5366:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5367:     my $link   = &designparm($function.'.link',  $domain);
                   5368: 
1.602     albertel 5369:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5370:     my $mono                 = 'monospace';
1.850     bisitz   5371:     my $data_table_head      = $sidebg;
                   5372:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5373:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5374:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5375:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5376:     my $mail_new             = '#FFBB77';
                   5377:     my $mail_new_hover       = '#DD9955';
                   5378:     my $mail_read            = '#BBBB77';
                   5379:     my $mail_read_hover      = '#999944';
                   5380:     my $mail_replied         = '#AAAA88';
                   5381:     my $mail_replied_hover   = '#888855';
                   5382:     my $mail_other           = '#99BBBB';
                   5383:     my $mail_other_hover     = '#669999';
1.391     albertel 5384:     my $table_header         = '#DDDDDD';
1.489     raeburn  5385:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5386:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5387:     my $button_hover         = '#BF2317';
1.392     albertel 5388: 
1.608     albertel 5389:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5390:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5391:                                              : '0 3px 0 4px';
1.448     albertel 5392: 
1.523     albertel 5393: 
1.343     albertel 5394:     return <<END;
1.947     droeschl 5395: 
                   5396: /* needed for iframe to allow 100% height in FF */
                   5397: body, html { 
                   5398:     margin: 0;
                   5399:     padding: 0 0.5%;
                   5400:     height: 99%; /* to avoid scrollbars */
                   5401: }
                   5402: 
1.795     www      5403: body {
1.911     bisitz   5404:   font-family: $sans;
                   5405:   line-height:130%;
                   5406:   font-size:0.83em;
                   5407:   color:$font;
1.795     www      5408: }
                   5409: 
1.959     onken    5410: a:focus,
                   5411: a:focus img {
1.795     www      5412:   color: red;
                   5413: }
1.698     harmsja  5414: 
1.911     bisitz   5415: form, .inline {
                   5416:   display: inline;
1.795     www      5417: }
1.721     harmsja  5418: 
1.795     www      5419: .LC_right {
1.911     bisitz   5420:   text-align:right;
1.795     www      5421: }
                   5422: 
                   5423: .LC_middle {
1.911     bisitz   5424:   vertical-align:middle;
1.795     www      5425: }
1.721     harmsja  5426: 
1.1075.2.38  raeburn  5427: .LC_floatleft {
                   5428:   float: left;
                   5429: }
                   5430: 
                   5431: .LC_floatright {
                   5432:   float: right;
                   5433: }
                   5434: 
1.911     bisitz   5435: .LC_400Box {
                   5436:   width:400px;
                   5437: }
1.721     harmsja  5438: 
1.947     droeschl 5439: .LC_iframecontainer {
                   5440:     width: 98%;
                   5441:     margin: 0;
                   5442:     position: fixed;
                   5443:     top: 8.5em;
                   5444:     bottom: 0;
                   5445: }
                   5446: 
                   5447: .LC_iframecontainer iframe{
                   5448:     border: none;
                   5449:     width: 100%;
                   5450:     height: 100%;
                   5451: }
                   5452: 
1.778     bisitz   5453: .LC_filename {
                   5454:   font-family: $mono;
                   5455:   white-space:pre;
1.921     bisitz   5456:   font-size: 120%;
1.778     bisitz   5457: }
                   5458: 
                   5459: .LC_fileicon {
                   5460:   border: none;
                   5461:   height: 1.3em;
                   5462:   vertical-align: text-bottom;
                   5463:   margin-right: 0.3em;
                   5464:   text-decoration:none;
                   5465: }
                   5466: 
1.1008    www      5467: .LC_setting {
                   5468:   text-decoration:underline;
                   5469: }
                   5470: 
1.350     albertel 5471: .LC_error {
                   5472:   color: red;
                   5473: }
1.795     www      5474: 
1.1075.2.15  raeburn  5475: .LC_warning {
                   5476:   color: darkorange;
                   5477: }
                   5478: 
1.457     albertel 5479: .LC_diff_removed {
1.733     bisitz   5480:   color: red;
1.394     albertel 5481: }
1.532     albertel 5482: 
                   5483: .LC_info,
1.457     albertel 5484: .LC_success,
                   5485: .LC_diff_added {
1.350     albertel 5486:   color: green;
                   5487: }
1.795     www      5488: 
1.802     bisitz   5489: div.LC_confirm_box {
                   5490:   background-color: #FAFAFA;
                   5491:   border: 1px solid $lg_border_color;
                   5492:   margin-right: 0;
                   5493:   padding: 5px;
                   5494: }
                   5495: 
                   5496: div.LC_confirm_box .LC_error img,
                   5497: div.LC_confirm_box .LC_success img {
                   5498:   vertical-align: middle;
                   5499: }
                   5500: 
1.440     albertel 5501: .LC_icon {
1.771     droeschl 5502:   border: none;
1.790     droeschl 5503:   vertical-align: middle;
1.771     droeschl 5504: }
                   5505: 
1.543     albertel 5506: .LC_docs_spacer {
                   5507:   width: 25px;
                   5508:   height: 1px;
1.771     droeschl 5509:   border: none;
1.543     albertel 5510: }
1.346     albertel 5511: 
1.532     albertel 5512: .LC_internal_info {
1.735     bisitz   5513:   color: #999999;
1.532     albertel 5514: }
                   5515: 
1.794     www      5516: .LC_discussion {
1.1050    www      5517:   background: $data_table_dark;
1.911     bisitz   5518:   border: 1px solid black;
                   5519:   margin: 2px;
1.794     www      5520: }
                   5521: 
                   5522: .LC_disc_action_left {
1.1050    www      5523:   background: $sidebg;
1.911     bisitz   5524:   text-align: left;
1.1050    www      5525:   padding: 4px;
                   5526:   margin: 2px;
1.794     www      5527: }
                   5528: 
                   5529: .LC_disc_action_right {
1.1050    www      5530:   background: $sidebg;
1.911     bisitz   5531:   text-align: right;
1.1050    www      5532:   padding: 4px;
                   5533:   margin: 2px;
1.794     www      5534: }
                   5535: 
                   5536: .LC_disc_new_item {
1.911     bisitz   5537:   background: white;
                   5538:   border: 2px solid red;
1.1050    www      5539:   margin: 4px;
                   5540:   padding: 4px;
1.794     www      5541: }
                   5542: 
                   5543: .LC_disc_old_item {
1.911     bisitz   5544:   background: white;
1.1050    www      5545:   margin: 4px;
                   5546:   padding: 4px;
1.794     www      5547: }
                   5548: 
1.458     albertel 5549: table.LC_pastsubmission {
                   5550:   border: 1px solid black;
                   5551:   margin: 2px;
                   5552: }
                   5553: 
1.924     bisitz   5554: table#LC_menubuttons {
1.345     albertel 5555:   width: 100%;
                   5556:   background: $pgbg;
1.392     albertel 5557:   border: 2px;
1.402     albertel 5558:   border-collapse: separate;
1.803     bisitz   5559:   padding: 0;
1.345     albertel 5560: }
1.392     albertel 5561: 
1.801     tempelho 5562: table#LC_title_bar a {
                   5563:   color: $fontmenu;
                   5564: }
1.836     bisitz   5565: 
1.807     droeschl 5566: table#LC_title_bar {
1.819     tempelho 5567:   clear: both;
1.836     bisitz   5568:   display: none;
1.807     droeschl 5569: }
                   5570: 
1.795     www      5571: table#LC_title_bar,
1.933     droeschl 5572: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5573: table#LC_title_bar.LC_with_remote {
1.359     albertel 5574:   width: 100%;
1.392     albertel 5575:   border-color: $pgbg;
                   5576:   border-style: solid;
                   5577:   border-width: $border;
1.379     albertel 5578:   background: $pgbg;
1.801     tempelho 5579:   color: $fontmenu;
1.392     albertel 5580:   border-collapse: collapse;
1.803     bisitz   5581:   padding: 0;
1.819     tempelho 5582:   margin: 0;
1.359     albertel 5583: }
1.795     www      5584: 
1.933     droeschl 5585: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5586:     margin: 0;
                   5587:     padding: 0;
1.933     droeschl 5588:     position: relative;
                   5589:     list-style: none;
1.913     droeschl 5590: }
1.933     droeschl 5591: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5592:     display: inline;
                   5593: }
1.933     droeschl 5594: 
                   5595: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5596:     padding: 0;
1.933     droeschl 5597:     margin: 0;
                   5598:     float: left;
1.913     droeschl 5599: }
1.933     droeschl 5600: .LC_breadcrumb_tools_tools {
                   5601:     padding: 0;
                   5602:     margin: 0;
1.913     droeschl 5603:     float: right;
                   5604: }
                   5605: 
1.359     albertel 5606: table#LC_title_bar td {
                   5607:   background: $tabbg;
                   5608: }
1.795     www      5609: 
1.911     bisitz   5610: table#LC_menubuttons img {
1.803     bisitz   5611:   border: none;
1.346     albertel 5612: }
1.795     www      5613: 
1.842     droeschl 5614: .LC_breadcrumbs_component {
1.911     bisitz   5615:   float: right;
                   5616:   margin: 0 1em;
1.357     albertel 5617: }
1.842     droeschl 5618: .LC_breadcrumbs_component img {
1.911     bisitz   5619:   vertical-align: middle;
1.777     tempelho 5620: }
1.795     www      5621: 
1.383     albertel 5622: td.LC_table_cell_checkbox {
                   5623:   text-align: center;
                   5624: }
1.795     www      5625: 
                   5626: .LC_fontsize_small {
1.911     bisitz   5627:   font-size: 70%;
1.705     tempelho 5628: }
                   5629: 
1.844     bisitz   5630: #LC_breadcrumbs {
1.911     bisitz   5631:   clear:both;
                   5632:   background: $sidebg;
                   5633:   border-bottom: 1px solid $lg_border_color;
                   5634:   line-height: 2.5em;
1.933     droeschl 5635:   overflow: hidden;
1.911     bisitz   5636:   margin: 0;
                   5637:   padding: 0;
1.995     raeburn  5638:   text-align: left;
1.819     tempelho 5639: }
1.862     bisitz   5640: 
1.1075.2.16  raeburn  5641: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5642:   clear:both;
                   5643:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5644:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  5645:   margin: 0 0 10px 0;
1.966     bisitz   5646:   padding: 3px;
1.995     raeburn  5647:   text-align: left;
1.822     bisitz   5648: }
                   5649: 
1.795     www      5650: .LC_fontsize_medium {
1.911     bisitz   5651:   font-size: 85%;
1.705     tempelho 5652: }
                   5653: 
1.795     www      5654: .LC_fontsize_large {
1.911     bisitz   5655:   font-size: 120%;
1.705     tempelho 5656: }
                   5657: 
1.346     albertel 5658: .LC_menubuttons_inline_text {
                   5659:   color: $font;
1.698     harmsja  5660:   font-size: 90%;
1.701     harmsja  5661:   padding-left:3px;
1.346     albertel 5662: }
                   5663: 
1.934     droeschl 5664: .LC_menubuttons_inline_text img{
                   5665:   vertical-align: middle;
                   5666: }
                   5667: 
1.1051    www      5668: li.LC_menubuttons_inline_text img {
1.951     onken    5669:   cursor:pointer;
1.1002    droeschl 5670:   text-decoration: none;
1.951     onken    5671: }
                   5672: 
1.526     www      5673: .LC_menubuttons_link {
                   5674:   text-decoration: none;
                   5675: }
1.795     www      5676: 
1.522     albertel 5677: .LC_menubuttons_category {
1.521     www      5678:   color: $font;
1.526     www      5679:   background: $pgbg;
1.521     www      5680:   font-size: larger;
                   5681:   font-weight: bold;
                   5682: }
                   5683: 
1.346     albertel 5684: td.LC_menubuttons_text {
1.911     bisitz   5685:   color: $font;
1.346     albertel 5686: }
1.706     harmsja  5687: 
1.346     albertel 5688: .LC_current_location {
                   5689:   background: $tabbg;
                   5690: }
1.795     www      5691: 
1.938     bisitz   5692: table.LC_data_table {
1.347     albertel 5693:   border: 1px solid #000000;
1.402     albertel 5694:   border-collapse: separate;
1.426     albertel 5695:   border-spacing: 1px;
1.610     albertel 5696:   background: $pgbg;
1.347     albertel 5697: }
1.795     www      5698: 
1.422     albertel 5699: .LC_data_table_dense {
                   5700:   font-size: small;
                   5701: }
1.795     www      5702: 
1.507     raeburn  5703: table.LC_nested_outer {
                   5704:   border: 1px solid #000000;
1.589     raeburn  5705:   border-collapse: collapse;
1.803     bisitz   5706:   border-spacing: 0;
1.507     raeburn  5707:   width: 100%;
                   5708: }
1.795     www      5709: 
1.879     raeburn  5710: table.LC_innerpickbox,
1.507     raeburn  5711: table.LC_nested {
1.803     bisitz   5712:   border: none;
1.589     raeburn  5713:   border-collapse: collapse;
1.803     bisitz   5714:   border-spacing: 0;
1.507     raeburn  5715:   width: 100%;
                   5716: }
1.795     www      5717: 
1.911     bisitz   5718: table.LC_data_table tr th,
                   5719: table.LC_calendar tr th,
1.879     raeburn  5720: table.LC_prior_tries tr th,
                   5721: table.LC_innerpickbox tr th {
1.349     albertel 5722:   font-weight: bold;
                   5723:   background-color: $data_table_head;
1.801     tempelho 5724:   color:$fontmenu;
1.701     harmsja  5725:   font-size:90%;
1.347     albertel 5726: }
1.795     www      5727: 
1.879     raeburn  5728: table.LC_innerpickbox tr th,
                   5729: table.LC_innerpickbox tr td {
                   5730:   vertical-align: top;
                   5731: }
                   5732: 
1.711     raeburn  5733: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5734:   background-color: #CCCCCC;
1.711     raeburn  5735:   font-weight: bold;
                   5736:   text-align: left;
                   5737: }
1.795     www      5738: 
1.912     bisitz   5739: table.LC_data_table tr.LC_odd_row > td {
                   5740:   background-color: $data_table_light;
                   5741:   padding: 2px;
                   5742:   vertical-align: top;
                   5743: }
                   5744: 
1.809     bisitz   5745: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5746:   background-color: $data_table_light;
1.912     bisitz   5747:   vertical-align: top;
                   5748: }
                   5749: 
                   5750: table.LC_data_table tr.LC_even_row > td {
                   5751:   background-color: $data_table_dark;
1.425     albertel 5752:   padding: 2px;
1.900     bisitz   5753:   vertical-align: top;
1.347     albertel 5754: }
1.795     www      5755: 
1.809     bisitz   5756: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5757:   background-color: $data_table_dark;
1.900     bisitz   5758:   vertical-align: top;
1.347     albertel 5759: }
1.795     www      5760: 
1.425     albertel 5761: table.LC_data_table tr.LC_data_table_highlight td {
                   5762:   background-color: $data_table_darker;
                   5763: }
1.795     www      5764: 
1.639     raeburn  5765: table.LC_data_table tr td.LC_leftcol_header {
                   5766:   background-color: $data_table_head;
                   5767:   font-weight: bold;
                   5768: }
1.795     www      5769: 
1.451     albertel 5770: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5771: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5772:   font-weight: bold;
                   5773:   font-style: italic;
                   5774:   text-align: center;
                   5775:   padding: 8px;
1.347     albertel 5776: }
1.795     www      5777: 
1.1075.2.30  raeburn  5778: table.LC_data_table tr.LC_empty_row td,
                   5779: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   5780:   background-color: $sidebg;
                   5781: }
                   5782: 
                   5783: table.LC_nested tr.LC_empty_row td {
                   5784:   background-color: #FFFFFF;
                   5785: }
                   5786: 
1.890     droeschl 5787: table.LC_caption {
                   5788: }
                   5789: 
1.507     raeburn  5790: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5791:   padding: 4ex
                   5792: }
1.795     www      5793: 
1.507     raeburn  5794: table.LC_nested_outer tr th {
                   5795:   font-weight: bold;
1.801     tempelho 5796:   color:$fontmenu;
1.507     raeburn  5797:   background-color: $data_table_head;
1.701     harmsja  5798:   font-size: small;
1.507     raeburn  5799:   border-bottom: 1px solid #000000;
                   5800: }
1.795     www      5801: 
1.507     raeburn  5802: table.LC_nested_outer tr td.LC_subheader {
                   5803:   background-color: $data_table_head;
                   5804:   font-weight: bold;
                   5805:   font-size: small;
                   5806:   border-bottom: 1px solid #000000;
                   5807:   text-align: right;
1.451     albertel 5808: }
1.795     www      5809: 
1.507     raeburn  5810: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5811:   background-color: #CCCCCC;
1.451     albertel 5812:   font-weight: bold;
                   5813:   font-size: small;
1.507     raeburn  5814:   text-align: center;
                   5815: }
1.795     www      5816: 
1.589     raeburn  5817: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5818: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5819:   text-align: left;
1.451     albertel 5820: }
1.795     www      5821: 
1.507     raeburn  5822: table.LC_nested td {
1.735     bisitz   5823:   background-color: #FFFFFF;
1.451     albertel 5824:   font-size: small;
1.507     raeburn  5825: }
1.795     www      5826: 
1.507     raeburn  5827: table.LC_nested_outer tr th.LC_right_item,
                   5828: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5829: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5830: table.LC_nested tr td.LC_right_item {
1.451     albertel 5831:   text-align: right;
                   5832: }
                   5833: 
1.507     raeburn  5834: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5835:   background-color: #EEEEEE;
1.451     albertel 5836: }
                   5837: 
1.473     raeburn  5838: table.LC_createuser {
                   5839: }
                   5840: 
                   5841: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5842:   font-size: small;
1.473     raeburn  5843: }
                   5844: 
                   5845: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5846:   background-color: #CCCCCC;
1.473     raeburn  5847:   font-weight: bold;
                   5848:   text-align: center;
                   5849: }
                   5850: 
1.349     albertel 5851: table.LC_calendar {
                   5852:   border: 1px solid #000000;
                   5853:   border-collapse: collapse;
1.917     raeburn  5854:   width: 98%;
1.349     albertel 5855: }
1.795     www      5856: 
1.349     albertel 5857: table.LC_calendar_pickdate {
                   5858:   font-size: xx-small;
                   5859: }
1.795     www      5860: 
1.349     albertel 5861: table.LC_calendar tr td {
                   5862:   border: 1px solid #000000;
                   5863:   vertical-align: top;
1.917     raeburn  5864:   width: 14%;
1.349     albertel 5865: }
1.795     www      5866: 
1.349     albertel 5867: table.LC_calendar tr td.LC_calendar_day_empty {
                   5868:   background-color: $data_table_dark;
                   5869: }
1.795     www      5870: 
1.779     bisitz   5871: table.LC_calendar tr td.LC_calendar_day_current {
                   5872:   background-color: $data_table_highlight;
1.777     tempelho 5873: }
1.795     www      5874: 
1.938     bisitz   5875: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5876:   background-color: $mail_new;
                   5877: }
1.795     www      5878: 
1.938     bisitz   5879: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5880:   background-color: $mail_new_hover;
                   5881: }
1.795     www      5882: 
1.938     bisitz   5883: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5884:   background-color: $mail_read;
                   5885: }
1.795     www      5886: 
1.938     bisitz   5887: /*
                   5888: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5889:   background-color: $mail_read_hover;
                   5890: }
1.938     bisitz   5891: */
1.795     www      5892: 
1.938     bisitz   5893: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5894:   background-color: $mail_replied;
                   5895: }
1.795     www      5896: 
1.938     bisitz   5897: /*
                   5898: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5899:   background-color: $mail_replied_hover;
                   5900: }
1.938     bisitz   5901: */
1.795     www      5902: 
1.938     bisitz   5903: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5904:   background-color: $mail_other;
                   5905: }
1.795     www      5906: 
1.938     bisitz   5907: /*
                   5908: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5909:   background-color: $mail_other_hover;
                   5910: }
1.938     bisitz   5911: */
1.494     raeburn  5912: 
1.777     tempelho 5913: table.LC_data_table tr > td.LC_browser_file,
                   5914: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5915:   background: #AAEE77;
1.389     albertel 5916: }
1.795     www      5917: 
1.777     tempelho 5918: table.LC_data_table tr > td.LC_browser_file_locked,
                   5919: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5920:   background: #FFAA99;
1.387     albertel 5921: }
1.795     www      5922: 
1.777     tempelho 5923: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5924:   background: #888888;
1.779     bisitz   5925: }
1.795     www      5926: 
1.777     tempelho 5927: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5928: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5929:   background: #F8F866;
1.777     tempelho 5930: }
1.795     www      5931: 
1.696     bisitz   5932: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5933:   background: #E0E8FF;
1.387     albertel 5934: }
1.696     bisitz   5935: 
1.707     bisitz   5936: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5937:   /* background: #77FF77; */
1.707     bisitz   5938: }
1.795     www      5939: 
1.707     bisitz   5940: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5941:   border-right: 8px solid #FFFF77;
1.707     bisitz   5942: }
1.795     www      5943: 
1.707     bisitz   5944: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5945:   border-right: 8px solid #FFAA77;
1.707     bisitz   5946: }
1.795     www      5947: 
1.707     bisitz   5948: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5949:   border-right: 8px solid #FF7777;
1.707     bisitz   5950: }
1.795     www      5951: 
1.707     bisitz   5952: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5953:   border-right: 8px solid #AAFF77;
1.707     bisitz   5954: }
1.795     www      5955: 
1.707     bisitz   5956: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5957:   border-right: 8px solid #11CC55;
1.707     bisitz   5958: }
                   5959: 
1.388     albertel 5960: span.LC_current_location {
1.701     harmsja  5961:   font-size:larger;
1.388     albertel 5962:   background: $pgbg;
                   5963: }
1.387     albertel 5964: 
1.1029    www      5965: span.LC_current_nav_location {
                   5966:   font-weight:bold;
                   5967:   background: $sidebg;
                   5968: }
                   5969: 
1.395     albertel 5970: span.LC_parm_menu_item {
                   5971:   font-size: larger;
                   5972: }
1.795     www      5973: 
1.395     albertel 5974: span.LC_parm_scope_all {
                   5975:   color: red;
                   5976: }
1.795     www      5977: 
1.395     albertel 5978: span.LC_parm_scope_folder {
                   5979:   color: green;
                   5980: }
1.795     www      5981: 
1.395     albertel 5982: span.LC_parm_scope_resource {
                   5983:   color: orange;
                   5984: }
1.795     www      5985: 
1.395     albertel 5986: span.LC_parm_part {
                   5987:   color: blue;
                   5988: }
1.795     www      5989: 
1.911     bisitz   5990: span.LC_parm_folder,
                   5991: span.LC_parm_symb {
1.395     albertel 5992:   font-size: x-small;
                   5993:   font-family: $mono;
                   5994:   color: #AAAAAA;
                   5995: }
                   5996: 
1.977     bisitz   5997: ul.LC_parm_parmlist li {
                   5998:   display: inline-block;
                   5999:   padding: 0.3em 0.8em;
                   6000:   vertical-align: top;
                   6001:   width: 150px;
                   6002:   border-top:1px solid $lg_border_color;
                   6003: }
                   6004: 
1.795     www      6005: td.LC_parm_overview_level_menu,
                   6006: td.LC_parm_overview_map_menu,
                   6007: td.LC_parm_overview_parm_selectors,
                   6008: td.LC_parm_overview_restrictions  {
1.396     albertel 6009:   border: 1px solid black;
                   6010:   border-collapse: collapse;
                   6011: }
1.795     www      6012: 
1.396     albertel 6013: table.LC_parm_overview_restrictions td {
                   6014:   border-width: 1px 4px 1px 4px;
                   6015:   border-style: solid;
                   6016:   border-color: $pgbg;
                   6017:   text-align: center;
                   6018: }
1.795     www      6019: 
1.396     albertel 6020: table.LC_parm_overview_restrictions th {
                   6021:   background: $tabbg;
                   6022:   border-width: 1px 4px 1px 4px;
                   6023:   border-style: solid;
                   6024:   border-color: $pgbg;
                   6025: }
1.795     www      6026: 
1.398     albertel 6027: table#LC_helpmenu {
1.803     bisitz   6028:   border: none;
1.398     albertel 6029:   height: 55px;
1.803     bisitz   6030:   border-spacing: 0;
1.398     albertel 6031: }
                   6032: 
                   6033: table#LC_helpmenu fieldset legend {
                   6034:   font-size: larger;
                   6035: }
1.795     www      6036: 
1.397     albertel 6037: table#LC_helpmenu_links {
                   6038:   width: 100%;
                   6039:   border: 1px solid black;
                   6040:   background: $pgbg;
1.803     bisitz   6041:   padding: 0;
1.397     albertel 6042:   border-spacing: 1px;
                   6043: }
1.795     www      6044: 
1.397     albertel 6045: table#LC_helpmenu_links tr td {
                   6046:   padding: 1px;
                   6047:   background: $tabbg;
1.399     albertel 6048:   text-align: center;
                   6049:   font-weight: bold;
1.397     albertel 6050: }
1.396     albertel 6051: 
1.795     www      6052: table#LC_helpmenu_links a:link,
                   6053: table#LC_helpmenu_links a:visited,
1.397     albertel 6054: table#LC_helpmenu_links a:active {
                   6055:   text-decoration: none;
                   6056:   color: $font;
                   6057: }
1.795     www      6058: 
1.397     albertel 6059: table#LC_helpmenu_links a:hover {
                   6060:   text-decoration: underline;
                   6061:   color: $vlink;
                   6062: }
1.396     albertel 6063: 
1.417     albertel 6064: .LC_chrt_popup_exists {
                   6065:   border: 1px solid #339933;
                   6066:   margin: -1px;
                   6067: }
1.795     www      6068: 
1.417     albertel 6069: .LC_chrt_popup_up {
                   6070:   border: 1px solid yellow;
                   6071:   margin: -1px;
                   6072: }
1.795     www      6073: 
1.417     albertel 6074: .LC_chrt_popup {
                   6075:   border: 1px solid #8888FF;
                   6076:   background: #CCCCFF;
                   6077: }
1.795     www      6078: 
1.421     albertel 6079: table.LC_pick_box {
                   6080:   border-collapse: separate;
                   6081:   background: white;
                   6082:   border: 1px solid black;
                   6083:   border-spacing: 1px;
                   6084: }
1.795     www      6085: 
1.421     albertel 6086: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6087:   background: $sidebg;
1.421     albertel 6088:   font-weight: bold;
1.900     bisitz   6089:   text-align: left;
1.740     bisitz   6090:   vertical-align: top;
1.421     albertel 6091:   width: 184px;
                   6092:   padding: 8px;
                   6093: }
1.795     www      6094: 
1.579     raeburn  6095: table.LC_pick_box td.LC_pick_box_value {
                   6096:   text-align: left;
                   6097:   padding: 8px;
                   6098: }
1.795     www      6099: 
1.579     raeburn  6100: table.LC_pick_box td.LC_pick_box_select {
                   6101:   text-align: left;
                   6102:   padding: 8px;
                   6103: }
1.795     www      6104: 
1.424     albertel 6105: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6106:   padding: 0;
1.421     albertel 6107:   height: 1px;
                   6108:   background: black;
                   6109: }
1.795     www      6110: 
1.421     albertel 6111: table.LC_pick_box td.LC_pick_box_submit {
                   6112:   text-align: right;
                   6113: }
1.795     www      6114: 
1.579     raeburn  6115: table.LC_pick_box td.LC_evenrow_value {
                   6116:   text-align: left;
                   6117:   padding: 8px;
                   6118:   background-color: $data_table_light;
                   6119: }
1.795     www      6120: 
1.579     raeburn  6121: table.LC_pick_box td.LC_oddrow_value {
                   6122:   text-align: left;
                   6123:   padding: 8px;
                   6124:   background-color: $data_table_light;
                   6125: }
1.795     www      6126: 
1.579     raeburn  6127: span.LC_helpform_receipt_cat {
                   6128:   font-weight: bold;
                   6129: }
1.795     www      6130: 
1.424     albertel 6131: table.LC_group_priv_box {
                   6132:   background: white;
                   6133:   border: 1px solid black;
                   6134:   border-spacing: 1px;
                   6135: }
1.795     www      6136: 
1.424     albertel 6137: table.LC_group_priv_box td.LC_pick_box_title {
                   6138:   background: $tabbg;
                   6139:   font-weight: bold;
                   6140:   text-align: right;
                   6141:   width: 184px;
                   6142: }
1.795     www      6143: 
1.424     albertel 6144: table.LC_group_priv_box td.LC_groups_fixed {
                   6145:   background: $data_table_light;
                   6146:   text-align: center;
                   6147: }
1.795     www      6148: 
1.424     albertel 6149: table.LC_group_priv_box td.LC_groups_optional {
                   6150:   background: $data_table_dark;
                   6151:   text-align: center;
                   6152: }
1.795     www      6153: 
1.424     albertel 6154: table.LC_group_priv_box td.LC_groups_functionality {
                   6155:   background: $data_table_darker;
                   6156:   text-align: center;
                   6157:   font-weight: bold;
                   6158: }
1.795     www      6159: 
1.424     albertel 6160: table.LC_group_priv td {
                   6161:   text-align: left;
1.803     bisitz   6162:   padding: 0;
1.424     albertel 6163: }
                   6164: 
                   6165: .LC_navbuttons {
                   6166:   margin: 2ex 0ex 2ex 0ex;
                   6167: }
1.795     www      6168: 
1.423     albertel 6169: .LC_topic_bar {
                   6170:   font-weight: bold;
                   6171:   background: $tabbg;
1.918     wenzelju 6172:   margin: 1em 0em 1em 2em;
1.805     bisitz   6173:   padding: 3px;
1.918     wenzelju 6174:   font-size: 1.2em;
1.423     albertel 6175: }
1.795     www      6176: 
1.423     albertel 6177: .LC_topic_bar span {
1.918     wenzelju 6178:   left: 0.5em;
                   6179:   position: absolute;
1.423     albertel 6180:   vertical-align: middle;
1.918     wenzelju 6181:   font-size: 1.2em;
1.423     albertel 6182: }
1.795     www      6183: 
1.423     albertel 6184: table.LC_course_group_status {
                   6185:   margin: 20px;
                   6186: }
1.795     www      6187: 
1.423     albertel 6188: table.LC_status_selector td {
                   6189:   vertical-align: top;
                   6190:   text-align: center;
1.424     albertel 6191:   padding: 4px;
                   6192: }
1.795     www      6193: 
1.599     albertel 6194: div.LC_feedback_link {
1.616     albertel 6195:   clear: both;
1.829     kalberla 6196:   background: $sidebg;
1.779     bisitz   6197:   width: 100%;
1.829     kalberla 6198:   padding-bottom: 10px;
                   6199:   border: 1px $tabbg solid;
1.833     kalberla 6200:   height: 22px;
                   6201:   line-height: 22px;
                   6202:   padding-top: 5px;
                   6203: }
                   6204: 
                   6205: div.LC_feedback_link img {
                   6206:   height: 22px;
1.867     kalberla 6207:   vertical-align:middle;
1.829     kalberla 6208: }
                   6209: 
1.911     bisitz   6210: div.LC_feedback_link a {
1.829     kalberla 6211:   text-decoration: none;
1.489     raeburn  6212: }
1.795     www      6213: 
1.867     kalberla 6214: div.LC_comblock {
1.911     bisitz   6215:   display:inline;
1.867     kalberla 6216:   color:$font;
                   6217:   font-size:90%;
                   6218: }
                   6219: 
                   6220: div.LC_feedback_link div.LC_comblock {
                   6221:   padding-left:5px;
                   6222: }
                   6223: 
                   6224: div.LC_feedback_link div.LC_comblock a {
                   6225:   color:$font;
                   6226: }
                   6227: 
1.489     raeburn  6228: span.LC_feedback_link {
1.858     bisitz   6229:   /* background: $feedback_link_bg; */
1.599     albertel 6230:   font-size: larger;
                   6231: }
1.795     www      6232: 
1.599     albertel 6233: span.LC_message_link {
1.858     bisitz   6234:   /* background: $feedback_link_bg; */
1.599     albertel 6235:   font-size: larger;
                   6236:   position: absolute;
                   6237:   right: 1em;
1.489     raeburn  6238: }
1.421     albertel 6239: 
1.515     albertel 6240: table.LC_prior_tries {
1.524     albertel 6241:   border: 1px solid #000000;
                   6242:   border-collapse: separate;
                   6243:   border-spacing: 1px;
1.515     albertel 6244: }
1.523     albertel 6245: 
1.515     albertel 6246: table.LC_prior_tries td {
1.524     albertel 6247:   padding: 2px;
1.515     albertel 6248: }
1.523     albertel 6249: 
                   6250: .LC_answer_correct {
1.795     www      6251:   background: lightgreen;
                   6252:   color: darkgreen;
                   6253:   padding: 6px;
1.523     albertel 6254: }
1.795     www      6255: 
1.523     albertel 6256: .LC_answer_charged_try {
1.797     www      6257:   background: #FFAAAA;
1.795     www      6258:   color: darkred;
                   6259:   padding: 6px;
1.523     albertel 6260: }
1.795     www      6261: 
1.779     bisitz   6262: .LC_answer_not_charged_try,
1.523     albertel 6263: .LC_answer_no_grade,
                   6264: .LC_answer_late {
1.795     www      6265:   background: lightyellow;
1.523     albertel 6266:   color: black;
1.795     www      6267:   padding: 6px;
1.523     albertel 6268: }
1.795     www      6269: 
1.523     albertel 6270: .LC_answer_previous {
1.795     www      6271:   background: lightblue;
                   6272:   color: darkblue;
                   6273:   padding: 6px;
1.523     albertel 6274: }
1.795     www      6275: 
1.779     bisitz   6276: .LC_answer_no_message {
1.777     tempelho 6277:   background: #FFFFFF;
                   6278:   color: black;
1.795     www      6279:   padding: 6px;
1.779     bisitz   6280: }
1.795     www      6281: 
1.779     bisitz   6282: .LC_answer_unknown {
                   6283:   background: orange;
                   6284:   color: black;
1.795     www      6285:   padding: 6px;
1.777     tempelho 6286: }
1.795     www      6287: 
1.529     albertel 6288: span.LC_prior_numerical,
                   6289: span.LC_prior_string,
                   6290: span.LC_prior_custom,
                   6291: span.LC_prior_reaction,
                   6292: span.LC_prior_math {
1.925     bisitz   6293:   font-family: $mono;
1.523     albertel 6294:   white-space: pre;
                   6295: }
                   6296: 
1.525     albertel 6297: span.LC_prior_string {
1.925     bisitz   6298:   font-family: $mono;
1.525     albertel 6299:   white-space: pre;
                   6300: }
                   6301: 
1.523     albertel 6302: table.LC_prior_option {
                   6303:   width: 100%;
                   6304:   border-collapse: collapse;
                   6305: }
1.795     www      6306: 
1.911     bisitz   6307: table.LC_prior_rank,
1.795     www      6308: table.LC_prior_match {
1.528     albertel 6309:   border-collapse: collapse;
                   6310: }
1.795     www      6311: 
1.528     albertel 6312: table.LC_prior_option tr td,
                   6313: table.LC_prior_rank tr td,
                   6314: table.LC_prior_match tr td {
1.524     albertel 6315:   border: 1px solid #000000;
1.515     albertel 6316: }
                   6317: 
1.855     bisitz   6318: .LC_nobreak {
1.544     albertel 6319:   white-space: nowrap;
1.519     raeburn  6320: }
                   6321: 
1.576     raeburn  6322: span.LC_cusr_emph {
                   6323:   font-style: italic;
                   6324: }
                   6325: 
1.633     raeburn  6326: span.LC_cusr_subheading {
                   6327:   font-weight: normal;
                   6328:   font-size: 85%;
                   6329: }
                   6330: 
1.861     bisitz   6331: div.LC_docs_entry_move {
1.859     bisitz   6332:   border: 1px solid #BBBBBB;
1.545     albertel 6333:   background: #DDDDDD;
1.861     bisitz   6334:   width: 22px;
1.859     bisitz   6335:   padding: 1px;
                   6336:   margin: 0;
1.545     albertel 6337: }
                   6338: 
1.861     bisitz   6339: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6340: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6341:   font-size: x-small;
                   6342: }
1.795     www      6343: 
1.861     bisitz   6344: .LC_docs_entry_parameter {
                   6345:   white-space: nowrap;
                   6346: }
                   6347: 
1.544     albertel 6348: .LC_docs_copy {
1.545     albertel 6349:   color: #000099;
1.544     albertel 6350: }
1.795     www      6351: 
1.544     albertel 6352: .LC_docs_cut {
1.545     albertel 6353:   color: #550044;
1.544     albertel 6354: }
1.795     www      6355: 
1.544     albertel 6356: .LC_docs_rename {
1.545     albertel 6357:   color: #009900;
1.544     albertel 6358: }
1.795     www      6359: 
1.544     albertel 6360: .LC_docs_remove {
1.545     albertel 6361:   color: #990000;
                   6362: }
                   6363: 
1.547     albertel 6364: .LC_docs_reinit_warn,
                   6365: .LC_docs_ext_edit {
                   6366:   font-size: x-small;
                   6367: }
                   6368: 
1.545     albertel 6369: table.LC_docs_adddocs td,
                   6370: table.LC_docs_adddocs th {
                   6371:   border: 1px solid #BBBBBB;
                   6372:   padding: 4px;
                   6373:   background: #DDDDDD;
1.543     albertel 6374: }
                   6375: 
1.584     albertel 6376: table.LC_sty_begin {
                   6377:   background: #BBFFBB;
                   6378: }
1.795     www      6379: 
1.584     albertel 6380: table.LC_sty_end {
                   6381:   background: #FFBBBB;
                   6382: }
                   6383: 
1.589     raeburn  6384: table.LC_double_column {
1.803     bisitz   6385:   border-width: 0;
1.589     raeburn  6386:   border-collapse: collapse;
                   6387:   width: 100%;
                   6388:   padding: 2px;
                   6389: }
                   6390: 
                   6391: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6392:   top: 2px;
1.589     raeburn  6393:   left: 2px;
                   6394:   width: 47%;
                   6395:   vertical-align: top;
                   6396: }
                   6397: 
                   6398: table.LC_double_column tr td.LC_right_col {
                   6399:   top: 2px;
1.779     bisitz   6400:   right: 2px;
1.589     raeburn  6401:   width: 47%;
                   6402:   vertical-align: top;
                   6403: }
                   6404: 
1.591     raeburn  6405: div.LC_left_float {
                   6406:   float: left;
                   6407:   padding-right: 5%;
1.597     albertel 6408:   padding-bottom: 4px;
1.591     raeburn  6409: }
                   6410: 
                   6411: div.LC_clear_float_header {
1.597     albertel 6412:   padding-bottom: 2px;
1.591     raeburn  6413: }
                   6414: 
                   6415: div.LC_clear_float_footer {
1.597     albertel 6416:   padding-top: 10px;
1.591     raeburn  6417:   clear: both;
                   6418: }
                   6419: 
1.597     albertel 6420: div.LC_grade_show_user {
1.941     bisitz   6421: /*  border-left: 5px solid $sidebg; */
                   6422:   border-top: 5px solid #000000;
                   6423:   margin: 50px 0 0 0;
1.936     bisitz   6424:   padding: 15px 0 5px 10px;
1.597     albertel 6425: }
1.795     www      6426: 
1.936     bisitz   6427: div.LC_grade_show_user_odd_row {
1.941     bisitz   6428: /*  border-left: 5px solid #000000; */
                   6429: }
                   6430: 
                   6431: div.LC_grade_show_user div.LC_Box {
                   6432:   margin-right: 50px;
1.597     albertel 6433: }
                   6434: 
                   6435: div.LC_grade_submissions,
                   6436: div.LC_grade_message_center,
1.936     bisitz   6437: div.LC_grade_info_links {
1.597     albertel 6438:   margin: 5px;
                   6439:   width: 99%;
                   6440:   background: #FFFFFF;
                   6441: }
1.795     www      6442: 
1.597     albertel 6443: div.LC_grade_submissions_header,
1.936     bisitz   6444: div.LC_grade_message_center_header {
1.705     tempelho 6445:   font-weight: bold;
                   6446:   font-size: large;
1.597     albertel 6447: }
1.795     www      6448: 
1.597     albertel 6449: div.LC_grade_submissions_body,
1.936     bisitz   6450: div.LC_grade_message_center_body {
1.597     albertel 6451:   border: 1px solid black;
                   6452:   width: 99%;
                   6453:   background: #FFFFFF;
                   6454: }
1.795     www      6455: 
1.613     albertel 6456: table.LC_scantron_action {
                   6457:   width: 100%;
                   6458: }
1.795     www      6459: 
1.613     albertel 6460: table.LC_scantron_action tr th {
1.698     harmsja  6461:   font-weight:bold;
                   6462:   font-style:normal;
1.613     albertel 6463: }
1.795     www      6464: 
1.779     bisitz   6465: .LC_edit_problem_header,
1.614     albertel 6466: div.LC_edit_problem_footer {
1.705     tempelho 6467:   font-weight: normal;
                   6468:   font-size:  medium;
1.602     albertel 6469:   margin: 2px;
1.1060    bisitz   6470:   background-color: $sidebg;
1.600     albertel 6471: }
1.795     www      6472: 
1.600     albertel 6473: div.LC_edit_problem_header,
1.602     albertel 6474: div.LC_edit_problem_header div,
1.614     albertel 6475: div.LC_edit_problem_footer,
                   6476: div.LC_edit_problem_footer div,
1.602     albertel 6477: div.LC_edit_problem_editxml_header,
                   6478: div.LC_edit_problem_editxml_header div {
1.600     albertel 6479:   margin-top: 5px;
                   6480: }
1.795     www      6481: 
1.600     albertel 6482: div.LC_edit_problem_header_title {
1.705     tempelho 6483:   font-weight: bold;
                   6484:   font-size: larger;
1.602     albertel 6485:   background: $tabbg;
                   6486:   padding: 3px;
1.1060    bisitz   6487:   margin: 0 0 5px 0;
1.602     albertel 6488: }
1.795     www      6489: 
1.602     albertel 6490: table.LC_edit_problem_header_title {
                   6491:   width: 100%;
1.600     albertel 6492:   background: $tabbg;
1.602     albertel 6493: }
                   6494: 
                   6495: div.LC_edit_problem_discards {
                   6496:   float: left;
                   6497:   padding-bottom: 5px;
                   6498: }
1.795     www      6499: 
1.602     albertel 6500: div.LC_edit_problem_saves {
                   6501:   float: right;
                   6502:   padding-bottom: 5px;
1.600     albertel 6503: }
1.795     www      6504: 
1.1075.2.34  raeburn  6505: .LC_edit_opt {
                   6506:   padding-left: 1em;
                   6507:   white-space: nowrap;
                   6508: }
                   6509: 
1.1075.2.57  raeburn  6510: .LC_edit_problem_latexhelper{
                   6511:     text-align: right;
                   6512: }
                   6513: 
                   6514: #LC_edit_problem_colorful div{
                   6515:     margin-left: 40px;
                   6516: }
                   6517: 
1.911     bisitz   6518: img.stift {
1.803     bisitz   6519:   border-width: 0;
                   6520:   vertical-align: middle;
1.677     riegler  6521: }
1.680     riegler  6522: 
1.923     bisitz   6523: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6524:   vertical-align: top;
1.777     tempelho 6525: }
1.795     www      6526: 
1.716     raeburn  6527: div.LC_createcourse {
1.911     bisitz   6528:   margin: 10px 10px 10px 10px;
1.716     raeburn  6529: }
                   6530: 
1.917     raeburn  6531: .LC_dccid {
1.1075.2.38  raeburn  6532:   float: right;
1.917     raeburn  6533:   margin: 0.2em 0 0 0;
                   6534:   padding: 0;
                   6535:   font-size: 90%;
                   6536:   display:none;
                   6537: }
                   6538: 
1.897     wenzelju 6539: ol.LC_primary_menu a:hover,
1.721     harmsja  6540: ol#LC_MenuBreadcrumbs a:hover,
                   6541: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6542: ul#LC_secondary_menu a:hover,
1.721     harmsja  6543: .LC_FormSectionClearButton input:hover
1.795     www      6544: ul.LC_TabContent   li:hover a {
1.952     onken    6545:   color:$button_hover;
1.911     bisitz   6546:   text-decoration:none;
1.693     droeschl 6547: }
                   6548: 
1.779     bisitz   6549: h1 {
1.911     bisitz   6550:   padding: 0;
                   6551:   line-height:130%;
1.693     droeschl 6552: }
1.698     harmsja  6553: 
1.911     bisitz   6554: h2,
                   6555: h3,
                   6556: h4,
                   6557: h5,
                   6558: h6 {
                   6559:   margin: 5px 0 5px 0;
                   6560:   padding: 0;
                   6561:   line-height:130%;
1.693     droeschl 6562: }
1.795     www      6563: 
                   6564: .LC_hcell {
1.911     bisitz   6565:   padding:3px 15px 3px 15px;
                   6566:   margin: 0;
                   6567:   background-color:$tabbg;
                   6568:   color:$fontmenu;
                   6569:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6570: }
1.795     www      6571: 
1.840     bisitz   6572: .LC_Box > .LC_hcell {
1.911     bisitz   6573:   margin: 0 -10px 10px -10px;
1.835     bisitz   6574: }
                   6575: 
1.721     harmsja  6576: .LC_noBorder {
1.911     bisitz   6577:   border: 0;
1.698     harmsja  6578: }
1.693     droeschl 6579: 
1.721     harmsja  6580: .LC_FormSectionClearButton input {
1.911     bisitz   6581:   background-color:transparent;
                   6582:   border: none;
                   6583:   cursor:pointer;
                   6584:   text-decoration:underline;
1.693     droeschl 6585: }
1.763     bisitz   6586: 
                   6587: .LC_help_open_topic {
1.911     bisitz   6588:   color: #FFFFFF;
                   6589:   background-color: #EEEEFF;
                   6590:   margin: 1px;
                   6591:   padding: 4px;
                   6592:   border: 1px solid #000033;
                   6593:   white-space: nowrap;
                   6594:   /* vertical-align: middle; */
1.759     neumanie 6595: }
1.693     droeschl 6596: 
1.911     bisitz   6597: dl,
                   6598: ul,
                   6599: div,
                   6600: fieldset {
                   6601:   margin: 10px 10px 10px 0;
                   6602:   /* overflow: hidden; */
1.693     droeschl 6603: }
1.795     www      6604: 
1.838     bisitz   6605: fieldset > legend {
1.911     bisitz   6606:   font-weight: bold;
                   6607:   padding: 0 5px 0 5px;
1.838     bisitz   6608: }
                   6609: 
1.813     bisitz   6610: #LC_nav_bar {
1.911     bisitz   6611:   float: left;
1.995     raeburn  6612:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6613:   margin: 0 0 2px 0;
1.807     droeschl 6614: }
                   6615: 
1.916     droeschl 6616: #LC_realm {
                   6617:   margin: 0.2em 0 0 0;
                   6618:   padding: 0;
                   6619:   font-weight: bold;
                   6620:   text-align: center;
1.995     raeburn  6621:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6622: }
                   6623: 
1.911     bisitz   6624: #LC_nav_bar em {
                   6625:   font-weight: bold;
                   6626:   font-style: normal;
1.807     droeschl 6627: }
                   6628: 
1.897     wenzelju 6629: ol.LC_primary_menu {
1.934     droeschl 6630:   margin: 0;
1.1075.2.2  raeburn  6631:   padding: 0;
1.995     raeburn  6632:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6633: }
                   6634: 
1.852     droeschl 6635: ol#LC_PathBreadcrumbs {
1.911     bisitz   6636:   margin: 0;
1.693     droeschl 6637: }
                   6638: 
1.897     wenzelju 6639: ol.LC_primary_menu li {
1.1075.2.2  raeburn  6640:   color: RGB(80, 80, 80);
                   6641:   vertical-align: middle;
                   6642:   text-align: left;
                   6643:   list-style: none;
                   6644:   float: left;
                   6645: }
                   6646: 
                   6647: ol.LC_primary_menu li a {
                   6648:   display: block;
                   6649:   margin: 0;
                   6650:   padding: 0 5px 0 10px;
                   6651:   text-decoration: none;
                   6652: }
                   6653: 
                   6654: ol.LC_primary_menu li ul {
                   6655:   display: none;
                   6656:   width: 10em;
                   6657:   background-color: $data_table_light;
                   6658: }
                   6659: 
                   6660: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6661:   display: block;
                   6662:   position: absolute;
                   6663:   margin: 0;
                   6664:   padding: 0;
1.1075.2.5  raeburn  6665:   z-index: 2;
1.1075.2.2  raeburn  6666: }
                   6667: 
                   6668: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6669:   font-size: 90%;
1.911     bisitz   6670:   vertical-align: top;
1.1075.2.2  raeburn  6671:   float: none;
1.1075.2.5  raeburn  6672:   border-left: 1px solid black;
                   6673:   border-right: 1px solid black;
1.1075.2.2  raeburn  6674: }
                   6675: 
                   6676: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5  raeburn  6677:   background-color:$data_table_light;
1.1075.2.2  raeburn  6678: }
                   6679: 
                   6680: ol.LC_primary_menu li li a:hover {
                   6681:    color:$button_hover;
                   6682:    background-color:$data_table_dark;
1.693     droeschl 6683: }
                   6684: 
1.897     wenzelju 6685: ol.LC_primary_menu li img {
1.911     bisitz   6686:   vertical-align: bottom;
1.934     droeschl 6687:   height: 1.1em;
1.1075.2.3  raeburn  6688:   margin: 0.2em 0 0 0;
1.693     droeschl 6689: }
                   6690: 
1.897     wenzelju 6691: ol.LC_primary_menu a {
1.911     bisitz   6692:   color: RGB(80, 80, 80);
                   6693:   text-decoration: none;
1.693     droeschl 6694: }
1.795     www      6695: 
1.949     droeschl 6696: ol.LC_primary_menu a.LC_new_message {
                   6697:   font-weight:bold;
                   6698:   color: darkred;
                   6699: }
                   6700: 
1.975     raeburn  6701: ol.LC_docs_parameters {
                   6702:   margin-left: 0;
                   6703:   padding: 0;
                   6704:   list-style: none;
                   6705: }
                   6706: 
                   6707: ol.LC_docs_parameters li {
                   6708:   margin: 0;
                   6709:   padding-right: 20px;
                   6710:   display: inline;
                   6711: }
                   6712: 
1.976     raeburn  6713: ol.LC_docs_parameters li:before {
                   6714:   content: "\\002022 \\0020";
                   6715: }
                   6716: 
                   6717: li.LC_docs_parameters_title {
                   6718:   font-weight: bold;
                   6719: }
                   6720: 
                   6721: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6722:   content: "";
                   6723: }
                   6724: 
1.897     wenzelju 6725: ul#LC_secondary_menu {
1.1075.2.23  raeburn  6726:   clear: right;
1.911     bisitz   6727:   color: $fontmenu;
                   6728:   background: $tabbg;
                   6729:   list-style: none;
                   6730:   padding: 0;
                   6731:   margin: 0;
                   6732:   width: 100%;
1.995     raeburn  6733:   text-align: left;
1.1075.2.4  raeburn  6734:   float: left;
1.808     droeschl 6735: }
                   6736: 
1.897     wenzelju 6737: ul#LC_secondary_menu li {
1.911     bisitz   6738:   font-weight: bold;
                   6739:   line-height: 1.8em;
                   6740:   border-right: 1px solid black;
                   6741:   vertical-align: middle;
1.1075.2.4  raeburn  6742:   float: left;
                   6743: }
                   6744: 
                   6745: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6746:   background-color: $data_table_light;
                   6747: }
                   6748: 
                   6749: ul#LC_secondary_menu li a {
                   6750:   padding: 0 0.8em;
                   6751: }
                   6752: 
                   6753: ul#LC_secondary_menu li ul {
                   6754:   display: none;
                   6755: }
                   6756: 
                   6757: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6758:   display: block;
                   6759:   position: absolute;
                   6760:   margin: 0;
                   6761:   padding: 0;
                   6762:   list-style:none;
                   6763:   float: none;
                   6764:   background-color: $data_table_light;
1.1075.2.5  raeburn  6765:   z-index: 2;
1.1075.2.10  raeburn  6766:   margin-left: -1px;
1.1075.2.4  raeburn  6767: }
                   6768: 
                   6769: ul#LC_secondary_menu li ul li {
                   6770:   font-size: 90%;
                   6771:   vertical-align: top;
                   6772:   border-left: 1px solid black;
                   6773:   border-right: 1px solid black;
1.1075.2.33  raeburn  6774:   background-color: $data_table_light;
1.1075.2.4  raeburn  6775:   list-style:none;
                   6776:   float: none;
                   6777: }
                   6778: 
                   6779: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6780:   background-color: $data_table_dark;
1.807     droeschl 6781: }
                   6782: 
1.847     tempelho 6783: ul.LC_TabContent {
1.911     bisitz   6784:   display:block;
                   6785:   background: $sidebg;
                   6786:   border-bottom: solid 1px $lg_border_color;
                   6787:   list-style:none;
1.1020    raeburn  6788:   margin: -1px -10px 0 -10px;
1.911     bisitz   6789:   padding: 0;
1.693     droeschl 6790: }
                   6791: 
1.795     www      6792: ul.LC_TabContent li,
                   6793: ul.LC_TabContentBigger li {
1.911     bisitz   6794:   float:left;
1.741     harmsja  6795: }
1.795     www      6796: 
1.897     wenzelju 6797: ul#LC_secondary_menu li a {
1.911     bisitz   6798:   color: $fontmenu;
                   6799:   text-decoration: none;
1.693     droeschl 6800: }
1.795     www      6801: 
1.721     harmsja  6802: ul.LC_TabContent {
1.952     onken    6803:   min-height:20px;
1.721     harmsja  6804: }
1.795     www      6805: 
                   6806: ul.LC_TabContent li {
1.911     bisitz   6807:   vertical-align:middle;
1.959     onken    6808:   padding: 0 16px 0 10px;
1.911     bisitz   6809:   background-color:$tabbg;
                   6810:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6811:   border-left: solid 1px $font;
1.721     harmsja  6812: }
1.795     www      6813: 
1.847     tempelho 6814: ul.LC_TabContent .right {
1.911     bisitz   6815:   float:right;
1.847     tempelho 6816: }
                   6817: 
1.911     bisitz   6818: ul.LC_TabContent li a,
                   6819: ul.LC_TabContent li {
                   6820:   color:rgb(47,47,47);
                   6821:   text-decoration:none;
                   6822:   font-size:95%;
                   6823:   font-weight:bold;
1.952     onken    6824:   min-height:20px;
                   6825: }
                   6826: 
1.959     onken    6827: ul.LC_TabContent li a:hover,
                   6828: ul.LC_TabContent li a:focus {
1.952     onken    6829:   color: $button_hover;
1.959     onken    6830:   background:none;
                   6831:   outline:none;
1.952     onken    6832: }
                   6833: 
                   6834: ul.LC_TabContent li:hover {
                   6835:   color: $button_hover;
                   6836:   cursor:pointer;
1.721     harmsja  6837: }
1.795     www      6838: 
1.911     bisitz   6839: ul.LC_TabContent li.active {
1.952     onken    6840:   color: $font;
1.911     bisitz   6841:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6842:   border-bottom:solid 1px #FFFFFF;
                   6843:   cursor: default;
1.744     ehlerst  6844: }
1.795     www      6845: 
1.959     onken    6846: ul.LC_TabContent li.active a {
                   6847:   color:$font;
                   6848:   background:#FFFFFF;
                   6849:   outline: none;
                   6850: }
1.1047    raeburn  6851: 
                   6852: ul.LC_TabContent li.goback {
                   6853:   float: left;
                   6854:   border-left: none;
                   6855: }
                   6856: 
1.870     tempelho 6857: #maincoursedoc {
1.911     bisitz   6858:   clear:both;
1.870     tempelho 6859: }
                   6860: 
                   6861: ul.LC_TabContentBigger {
1.911     bisitz   6862:   display:block;
                   6863:   list-style:none;
                   6864:   padding: 0;
1.870     tempelho 6865: }
                   6866: 
1.795     www      6867: ul.LC_TabContentBigger li {
1.911     bisitz   6868:   vertical-align:bottom;
                   6869:   height: 30px;
                   6870:   font-size:110%;
                   6871:   font-weight:bold;
                   6872:   color: #737373;
1.841     tempelho 6873: }
                   6874: 
1.957     onken    6875: ul.LC_TabContentBigger li.active {
                   6876:   position: relative;
                   6877:   top: 1px;
                   6878: }
                   6879: 
1.870     tempelho 6880: ul.LC_TabContentBigger li a {
1.911     bisitz   6881:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6882:   height: 30px;
                   6883:   line-height: 30px;
                   6884:   text-align: center;
                   6885:   display: block;
                   6886:   text-decoration: none;
1.958     onken    6887:   outline: none;  
1.741     harmsja  6888: }
1.795     www      6889: 
1.870     tempelho 6890: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6891:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6892:   color:$font;
1.744     ehlerst  6893: }
1.795     www      6894: 
1.870     tempelho 6895: ul.LC_TabContentBigger li b {
1.911     bisitz   6896:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6897:   display: block;
                   6898:   float: left;
                   6899:   padding: 0 30px;
1.957     onken    6900:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6901: }
                   6902: 
1.956     onken    6903: ul.LC_TabContentBigger li:hover b {
                   6904:   color:$button_hover;
                   6905: }
                   6906: 
1.870     tempelho 6907: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6908:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6909:   color:$font;
1.957     onken    6910:   border: 0;
1.741     harmsja  6911: }
1.693     droeschl 6912: 
1.870     tempelho 6913: 
1.862     bisitz   6914: ul.LC_CourseBreadcrumbs {
                   6915:   background: $sidebg;
1.1020    raeburn  6916:   height: 2em;
1.862     bisitz   6917:   padding-left: 10px;
1.1020    raeburn  6918:   margin: 0;
1.862     bisitz   6919:   list-style-position: inside;
                   6920: }
                   6921: 
1.911     bisitz   6922: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6923: ol#LC_PathBreadcrumbs {
1.911     bisitz   6924:   padding-left: 10px;
                   6925:   margin: 0;
1.933     droeschl 6926:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6927: }
                   6928: 
1.911     bisitz   6929: ol#LC_MenuBreadcrumbs li,
                   6930: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6931: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6932:   display: inline;
1.933     droeschl 6933:   white-space: normal;  
1.693     droeschl 6934: }
                   6935: 
1.823     bisitz   6936: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6937: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6938:   text-decoration: none;
                   6939:   font-size:90%;
1.693     droeschl 6940: }
1.795     www      6941: 
1.969     droeschl 6942: ol#LC_MenuBreadcrumbs h1 {
                   6943:   display: inline;
                   6944:   font-size: 90%;
                   6945:   line-height: 2.5em;
                   6946:   margin: 0;
                   6947:   padding: 0;
                   6948: }
                   6949: 
1.795     www      6950: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6951:   text-decoration:none;
                   6952:   font-size:100%;
                   6953:   font-weight:bold;
1.693     droeschl 6954: }
1.795     www      6955: 
1.840     bisitz   6956: .LC_Box {
1.911     bisitz   6957:   border: solid 1px $lg_border_color;
                   6958:   padding: 0 10px 10px 10px;
1.746     neumanie 6959: }
1.795     www      6960: 
1.1020    raeburn  6961: .LC_DocsBox {
                   6962:   border: solid 1px $lg_border_color;
                   6963:   padding: 0 0 10px 10px;
                   6964: }
                   6965: 
1.795     www      6966: .LC_AboutMe_Image {
1.911     bisitz   6967:   float:left;
                   6968:   margin-right:10px;
1.747     neumanie 6969: }
1.795     www      6970: 
                   6971: .LC_Clear_AboutMe_Image {
1.911     bisitz   6972:   clear:left;
1.747     neumanie 6973: }
1.795     www      6974: 
1.721     harmsja  6975: dl.LC_ListStyleClean dt {
1.911     bisitz   6976:   padding-right: 5px;
                   6977:   display: table-header-group;
1.693     droeschl 6978: }
                   6979: 
1.721     harmsja  6980: dl.LC_ListStyleClean dd {
1.911     bisitz   6981:   display: table-row;
1.693     droeschl 6982: }
                   6983: 
1.721     harmsja  6984: .LC_ListStyleClean,
                   6985: .LC_ListStyleSimple,
                   6986: .LC_ListStyleNormal,
1.795     www      6987: .LC_ListStyleSpecial {
1.911     bisitz   6988:   /* display:block; */
                   6989:   list-style-position: inside;
                   6990:   list-style-type: none;
                   6991:   overflow: hidden;
                   6992:   padding: 0;
1.693     droeschl 6993: }
                   6994: 
1.721     harmsja  6995: .LC_ListStyleSimple li,
                   6996: .LC_ListStyleSimple dd,
                   6997: .LC_ListStyleNormal li,
                   6998: .LC_ListStyleNormal dd,
                   6999: .LC_ListStyleSpecial li,
1.795     www      7000: .LC_ListStyleSpecial dd {
1.911     bisitz   7001:   margin: 0;
                   7002:   padding: 5px 5px 5px 10px;
                   7003:   clear: both;
1.693     droeschl 7004: }
                   7005: 
1.721     harmsja  7006: .LC_ListStyleClean li,
                   7007: .LC_ListStyleClean dd {
1.911     bisitz   7008:   padding-top: 0;
                   7009:   padding-bottom: 0;
1.693     droeschl 7010: }
                   7011: 
1.721     harmsja  7012: .LC_ListStyleSimple dd,
1.795     www      7013: .LC_ListStyleSimple li {
1.911     bisitz   7014:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7015: }
                   7016: 
1.721     harmsja  7017: .LC_ListStyleSpecial li,
                   7018: .LC_ListStyleSpecial dd {
1.911     bisitz   7019:   list-style-type: none;
                   7020:   background-color: RGB(220, 220, 220);
                   7021:   margin-bottom: 4px;
1.693     droeschl 7022: }
                   7023: 
1.721     harmsja  7024: table.LC_SimpleTable {
1.911     bisitz   7025:   margin:5px;
                   7026:   border:solid 1px $lg_border_color;
1.795     www      7027: }
1.693     droeschl 7028: 
1.721     harmsja  7029: table.LC_SimpleTable tr {
1.911     bisitz   7030:   padding: 0;
                   7031:   border:solid 1px $lg_border_color;
1.693     droeschl 7032: }
1.795     www      7033: 
                   7034: table.LC_SimpleTable thead {
1.911     bisitz   7035:   background:rgb(220,220,220);
1.693     droeschl 7036: }
                   7037: 
1.721     harmsja  7038: div.LC_columnSection {
1.911     bisitz   7039:   display: block;
                   7040:   clear: both;
                   7041:   overflow: hidden;
                   7042:   margin: 0;
1.693     droeschl 7043: }
                   7044: 
1.721     harmsja  7045: div.LC_columnSection>* {
1.911     bisitz   7046:   float: left;
                   7047:   margin: 10px 20px 10px 0;
                   7048:   overflow:hidden;
1.693     droeschl 7049: }
1.721     harmsja  7050: 
1.795     www      7051: table em {
1.911     bisitz   7052:   font-weight: bold;
                   7053:   font-style: normal;
1.748     schulted 7054: }
1.795     www      7055: 
1.779     bisitz   7056: table.LC_tableBrowseRes,
1.795     www      7057: table.LC_tableOfContent {
1.911     bisitz   7058:   border:none;
                   7059:   border-spacing: 1px;
                   7060:   padding: 3px;
                   7061:   background-color: #FFFFFF;
                   7062:   font-size: 90%;
1.753     droeschl 7063: }
1.789     droeschl 7064: 
1.911     bisitz   7065: table.LC_tableOfContent {
                   7066:   border-collapse: collapse;
1.789     droeschl 7067: }
                   7068: 
1.771     droeschl 7069: table.LC_tableBrowseRes a,
1.768     schulted 7070: table.LC_tableOfContent a {
1.911     bisitz   7071:   background-color: transparent;
                   7072:   text-decoration: none;
1.753     droeschl 7073: }
                   7074: 
1.795     www      7075: table.LC_tableOfContent img {
1.911     bisitz   7076:   border: none;
                   7077:   height: 1.3em;
                   7078:   vertical-align: text-bottom;
                   7079:   margin-right: 0.3em;
1.753     droeschl 7080: }
1.757     schulted 7081: 
1.795     www      7082: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7083:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7084: }
                   7085: 
1.795     www      7086: a#LC_content_toolbar_everything {
1.911     bisitz   7087:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7088: }
                   7089: 
1.795     www      7090: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7091:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7092: }
                   7093: 
1.795     www      7094: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7095:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7096: }
                   7097: 
1.795     www      7098: a#LC_content_toolbar_changefolder {
1.911     bisitz   7099:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7100: }
                   7101: 
1.795     www      7102: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7103:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7104: }
                   7105: 
1.1043    raeburn  7106: a#LC_content_toolbar_edittoplevel {
                   7107:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7108: }
                   7109: 
1.795     www      7110: ul#LC_toolbar li a:hover {
1.911     bisitz   7111:   background-position: bottom center;
1.757     schulted 7112: }
                   7113: 
1.795     www      7114: ul#LC_toolbar {
1.911     bisitz   7115:   padding: 0;
                   7116:   margin: 2px;
                   7117:   list-style:none;
                   7118:   position:relative;
                   7119:   background-color:white;
1.1075.2.9  raeburn  7120:   overflow: auto;
1.757     schulted 7121: }
                   7122: 
1.795     www      7123: ul#LC_toolbar li {
1.911     bisitz   7124:   border:1px solid white;
                   7125:   padding: 0;
                   7126:   margin: 0;
                   7127:   float: left;
                   7128:   display:inline;
                   7129:   vertical-align:middle;
1.1075.2.9  raeburn  7130:   white-space: nowrap;
1.911     bisitz   7131: }
1.757     schulted 7132: 
1.783     amueller 7133: 
1.795     www      7134: a.LC_toolbarItem {
1.911     bisitz   7135:   display:block;
                   7136:   padding: 0;
                   7137:   margin: 0;
                   7138:   height: 32px;
                   7139:   width: 32px;
                   7140:   color:white;
                   7141:   border: none;
                   7142:   background-repeat:no-repeat;
                   7143:   background-color:transparent;
1.757     schulted 7144: }
                   7145: 
1.915     droeschl 7146: ul.LC_funclist {
                   7147:     margin: 0;
                   7148:     padding: 0.5em 1em 0.5em 0;
                   7149: }
                   7150: 
1.933     droeschl 7151: ul.LC_funclist > li:first-child {
                   7152:     font-weight:bold; 
                   7153:     margin-left:0.8em;
                   7154: }
                   7155: 
1.915     droeschl 7156: ul.LC_funclist + ul.LC_funclist {
                   7157:     /* 
                   7158:        left border as a seperator if we have more than
                   7159:        one list 
                   7160:     */
                   7161:     border-left: 1px solid $sidebg;
                   7162:     /* 
                   7163:        this hides the left border behind the border of the 
                   7164:        outer box if element is wrapped to the next 'line' 
                   7165:     */
                   7166:     margin-left: -1px;
                   7167: }
                   7168: 
1.843     bisitz   7169: ul.LC_funclist li {
1.915     droeschl 7170:   display: inline;
1.782     bisitz   7171:   white-space: nowrap;
1.915     droeschl 7172:   margin: 0 0 0 25px;
                   7173:   line-height: 150%;
1.782     bisitz   7174: }
                   7175: 
1.974     wenzelju 7176: .LC_hidden {
                   7177:   display: none;
                   7178: }
                   7179: 
1.1030    www      7180: .LCmodal-overlay {
                   7181: 		position:fixed;
                   7182: 		top:0;
                   7183: 		right:0;
                   7184: 		bottom:0;
                   7185: 		left:0;
                   7186: 		height:100%;
                   7187: 		width:100%;
                   7188: 		margin:0;
                   7189: 		padding:0;
                   7190: 		background:#999;
                   7191: 		opacity:.75;
                   7192: 		filter: alpha(opacity=75);
                   7193: 		-moz-opacity: 0.75;
                   7194: 		z-index:101;
                   7195: }
                   7196: 
                   7197: * html .LCmodal-overlay {   
                   7198: 		position: absolute;
                   7199: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7200: }
                   7201: 
                   7202: .LCmodal-window {
                   7203: 		position:fixed;
                   7204: 		top:50%;
                   7205: 		left:50%;
                   7206: 		margin:0;
                   7207: 		padding:0;
                   7208: 		z-index:102;
                   7209: 	}
                   7210: 
                   7211: * html .LCmodal-window {
                   7212: 		position:absolute;
                   7213: }
                   7214: 
                   7215: .LCclose-window {
                   7216: 		position:absolute;
                   7217: 		width:32px;
                   7218: 		height:32px;
                   7219: 		right:8px;
                   7220: 		top:8px;
                   7221: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7222: 		text-indent:-99999px;
                   7223: 		overflow:hidden;
                   7224: 		cursor:pointer;
                   7225: }
                   7226: 
1.1075.2.17  raeburn  7227: /*
                   7228:   styles used by TTH when "Default set of options to pass to tth/m
                   7229:   when converting TeX" in course settings has been set
                   7230: 
                   7231:   option passed: -t
                   7232: 
                   7233: */
                   7234: 
                   7235: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7236: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7237: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7238: td div.norm {line-height:normal;}
                   7239: 
                   7240: /*
                   7241:   option passed -y3
                   7242: */
                   7243: 
                   7244: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7245: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7246: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7247: 
1.343     albertel 7248: END
                   7249: }
                   7250: 
1.306     albertel 7251: =pod
                   7252: 
                   7253: =item * &headtag()
                   7254: 
                   7255: Returns a uniform footer for LON-CAPA web pages.
                   7256: 
1.307     albertel 7257: Inputs: $title - optional title for the head
                   7258:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7259:         $args - optional arguments
1.319     albertel 7260:             force_register - if is true call registerurl so the remote is 
                   7261:                              informed
1.415     albertel 7262:             redirect       -> array ref of
                   7263:                                    1- seconds before redirect occurs
                   7264:                                    2- url to redirect to
                   7265:                                    3- whether the side effect should occur
1.315     albertel 7266:                            (side effect of setting 
                   7267:                                $env{'internal.head.redirect'} to the url 
                   7268:                                redirected too)
1.352     albertel 7269:             domain         -> force to color decorate a page for a specific
                   7270:                                domain
                   7271:             function       -> force usage of a specific rolish color scheme
                   7272:             bgcolor        -> override the default page bgcolor
1.460     albertel 7273:             no_auto_mt_title
                   7274:                            -> prevent &mt()ing the title arg
1.464     albertel 7275: 
1.306     albertel 7276: =cut
                   7277: 
                   7278: sub headtag {
1.313     albertel 7279:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7280:     
1.363     albertel 7281:     my $function = $args->{'function'} || &get_users_function();
                   7282:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7283:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1075.2.52  raeburn  7284:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7285:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7286: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7287: 		   #time(),
1.418     albertel 7288: 		   $env{'environment.color.timestamp'},
1.363     albertel 7289: 		   $function,$domain,$bgcolor);
                   7290: 
1.369     www      7291:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7292: 
1.308     albertel 7293:     my $result =
                   7294: 	'<head>'.
1.1075.2.56  raeburn  7295: 	&font_settings($args);
1.319     albertel 7296: 
1.1064    raeburn  7297:     my $inhibitprint = &print_suppression();
                   7298: 
1.461     albertel 7299:     if (!$args->{'frameset'}) {
                   7300: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7301:     }
1.1075.2.12  raeburn  7302:     if ($args->{'force_register'}) {
                   7303:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7304:     }
1.436     albertel 7305:     if (!$args->{'no_nav_bar'} 
                   7306: 	&& !$args->{'only_body'}
                   7307: 	&& !$args->{'frameset'}) {
1.1075.2.52  raeburn  7308: 	$result .= &help_menu_js($httphost);
1.1032    www      7309:         $result.=&modal_window();
1.1038    www      7310:         $result.=&togglebox_script();
1.1034    www      7311:         $result.=&wishlist_window();
1.1041    www      7312:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7313:     } else {
                   7314:         if ($args->{'add_modal'}) {
                   7315:            $result.=&modal_window();
                   7316:         }
                   7317:         if ($args->{'add_wishlist'}) {
                   7318:            $result.=&wishlist_window();
                   7319:         }
1.1038    www      7320:         if ($args->{'add_togglebox'}) {
                   7321:            $result.=&togglebox_script();
                   7322:         }
1.1041    www      7323:         if ($args->{'add_progressbar'}) {
                   7324:            $result.=&LCprogressbarUpdate_script();
                   7325:         }
1.436     albertel 7326:     }
1.314     albertel 7327:     if (ref($args->{'redirect'})) {
1.414     albertel 7328: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7329: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7330: 	if (!$inhibit_continue) {
                   7331: 	    $env{'internal.head.redirect'} = $url;
                   7332: 	}
1.313     albertel 7333: 	$result.=<<ADDMETA
                   7334: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7335: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7336: ADDMETA
                   7337:     }
1.306     albertel 7338:     if (!defined($title)) {
                   7339: 	$title = 'The LearningOnline Network with CAPA';
                   7340:     }
1.460     albertel 7341:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7342:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61  raeburn  7343: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7344:     if (!$args->{'frameset'}) {
                   7345:         $result .= ' /';
                   7346:     }
                   7347:     $result .= '>'
1.1064    raeburn  7348:         .$inhibitprint
1.414     albertel 7349: 	.$head_extra;
1.1075.2.42  raeburn  7350:     if ($env{'browser.mobile'}) {
                   7351:         $result .= '
                   7352: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7353: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7354:     }
1.962     droeschl 7355:     return $result.'</head>';
1.306     albertel 7356: }
                   7357: 
                   7358: =pod
                   7359: 
1.340     albertel 7360: =item * &font_settings()
                   7361: 
                   7362: Returns neccessary <meta> to set the proper encoding
                   7363: 
1.1075.2.56  raeburn  7364: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 7365: 
                   7366: =cut
                   7367: 
                   7368: sub font_settings {
1.1075.2.56  raeburn  7369:     my ($args) = @_;
1.340     albertel 7370:     my $headerstring='';
1.1075.2.56  raeburn  7371:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   7372:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340     albertel 7373: 	$headerstring.=
1.1075.2.61  raeburn  7374: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   7375:         if (!$args->{'frameset'}) {
                   7376:             $headerstring.= ' /';
                   7377:         }
                   7378:         $headerstring .= '>'."\n";
1.340     albertel 7379:     }
                   7380:     return $headerstring;
                   7381: }
                   7382: 
1.341     albertel 7383: =pod
                   7384: 
1.1064    raeburn  7385: =item * &print_suppression()
                   7386: 
                   7387: In course context returns css which causes the body to be blank when media="print",
                   7388: if printout generation is unavailable for the current resource.
                   7389: 
                   7390: This could be because:
                   7391: 
                   7392: (a) printstartdate is in the future
                   7393: 
                   7394: (b) printenddate is in the past
                   7395: 
                   7396: (c) there is an active exam block with "printout"
                   7397: functionality blocked
                   7398: 
                   7399: Users with pav, pfo or evb privileges are exempt.
                   7400: 
                   7401: Inputs: none
                   7402: 
                   7403: =cut
                   7404: 
                   7405: 
                   7406: sub print_suppression {
                   7407:     my $noprint;
                   7408:     if ($env{'request.course.id'}) {
                   7409:         my $scope = $env{'request.course.id'};
                   7410:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7411:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7412:             return;
                   7413:         }
                   7414:         if ($env{'request.course.sec'} ne '') {
                   7415:             $scope .= "/$env{'request.course.sec'}";
                   7416:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7417:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7418:                 return;
1.1064    raeburn  7419:             }
                   7420:         }
                   7421:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7422:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1065    raeburn  7423:         my $blocked = &blocking_status('printout',$cnum,$cdom);
1.1064    raeburn  7424:         if ($blocked) {
                   7425:             my $checkrole = "cm./$cdom/$cnum";
                   7426:             if ($env{'request.course.sec'} ne '') {
                   7427:                 $checkrole .= "/$env{'request.course.sec'}";
                   7428:             }
                   7429:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7430:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7431:                 $noprint = 1;
                   7432:             }
                   7433:         }
                   7434:         unless ($noprint) {
                   7435:             my $symb = &Apache::lonnet::symbread();
                   7436:             if ($symb ne '') {
                   7437:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7438:                 if (ref($navmap)) {
                   7439:                     my $res = $navmap->getBySymb($symb);
                   7440:                     if (ref($res)) {
                   7441:                         if (!$res->resprintable()) {
                   7442:                             $noprint = 1;
                   7443:                         }
                   7444:                     }
                   7445:                 }
                   7446:             }
                   7447:         }
                   7448:         if ($noprint) {
                   7449:             return <<"ENDSTYLE";
                   7450: <style type="text/css" media="print">
                   7451:     body { display:none }
                   7452: </style>
                   7453: ENDSTYLE
                   7454:         }
                   7455:     }
                   7456:     return;
                   7457: }
                   7458: 
                   7459: =pod
                   7460: 
1.341     albertel 7461: =item * &xml_begin()
                   7462: 
                   7463: Returns the needed doctype and <html>
                   7464: 
                   7465: Inputs: none
                   7466: 
                   7467: =cut
                   7468: 
                   7469: sub xml_begin {
1.1075.2.61  raeburn  7470:     my ($is_frameset) = @_;
1.341     albertel 7471:     my $output='';
                   7472: 
                   7473:     if ($env{'browser.mathml'}) {
                   7474: 	$output='<?xml version="1.0"?>'
                   7475:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7476: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7477:             
                   7478: #	    .'<!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">] >'
                   7479: 	    .'<!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">'
                   7480:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7481: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61  raeburn  7482:     } elsif ($is_frameset) {
                   7483:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   7484:                 '<html>'."\n";
1.341     albertel 7485:     } else {
1.1075.2.61  raeburn  7486: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   7487:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 7488:     }
                   7489:     return $output;
                   7490: }
1.340     albertel 7491: 
                   7492: =pod
                   7493: 
1.306     albertel 7494: =item * &start_page()
                   7495: 
                   7496: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7497: 
1.648     raeburn  7498: Inputs:
                   7499: 
                   7500: =over 4
                   7501: 
                   7502: $title - optional title for the page
                   7503: 
                   7504: $head_extra - optional extra HTML to incude inside the <head>
                   7505: 
                   7506: $args - additional optional args supported are:
                   7507: 
                   7508: =over 8
                   7509: 
                   7510:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7511:                                     arg on
1.814     bisitz   7512:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7513:              add_entries    -> additional attributes to add to the  <body>
                   7514:              domain         -> force to color decorate a page for a 
1.317     albertel 7515:                                     specific domain
1.648     raeburn  7516:              function       -> force usage of a specific rolish color
1.317     albertel 7517:                                     scheme
1.648     raeburn  7518:              redirect       -> see &headtag()
                   7519:              bgcolor        -> override the default page bg color
                   7520:              js_ready       -> return a string ready for being used in 
1.317     albertel 7521:                                     a javascript writeln
1.648     raeburn  7522:              html_encode    -> return a string ready for being used in 
1.320     albertel 7523:                                     a html attribute
1.648     raeburn  7524:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7525:                                     $forcereg arg
1.648     raeburn  7526:              frameset       -> if true will start with a <frameset>
1.330     albertel 7527:                                     rather than <body>
1.648     raeburn  7528:              skip_phases    -> hash ref of 
1.338     albertel 7529:                                     head -> skip the <html><head> generation
                   7530:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  7531:              no_inline_link -> if true and in remote mode, don't show the
                   7532:                                     'Switch To Inline Menu' link
1.648     raeburn  7533:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7534:              inherit_jsmath -> when creating popup window in a page,
                   7535:                                     should it have jsmath forced on by the
                   7536:                                     current page
1.867     kalberla 7537:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7538:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.15  raeburn  7539:              group          -> includes the current group, if page is for a
                   7540:                                specific group
1.361     albertel 7541: 
1.648     raeburn  7542: =back
1.460     albertel 7543: 
1.648     raeburn  7544: =back
1.562     albertel 7545: 
1.306     albertel 7546: =cut
                   7547: 
                   7548: sub start_page {
1.309     albertel 7549:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7550:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7551: 
1.315     albertel 7552:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  7553:     my ($result,@advtools);
1.964     droeschl 7554: 
1.338     albertel 7555:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62  raeburn  7556:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 7557:     }
                   7558:     
                   7559:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7560: 	if ($args->{'frameset'}) {
                   7561: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7562: 						$args->{'add_entries'});
                   7563: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7564:         } else {
                   7565:             $result .=
                   7566:                 &bodytag($title, 
                   7567:                          $args->{'function'},       $args->{'add_entries'},
                   7568:                          $args->{'only_body'},      $args->{'domain'},
                   7569:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  7570:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  7571:                          $args,                     \@advtools);
1.831     bisitz   7572:         }
1.330     albertel 7573:     }
1.338     albertel 7574: 
1.315     albertel 7575:     if ($args->{'js_ready'}) {
1.713     kaisler  7576: 		$result = &js_ready($result);
1.315     albertel 7577:     }
1.320     albertel 7578:     if ($args->{'html_encode'}) {
1.713     kaisler  7579: 		$result = &html_encode($result);
                   7580:     }
                   7581: 
1.813     bisitz   7582:     # Preparation for new and consistent functionlist at top of screen
                   7583:     # if ($args->{'functionlist'}) {
                   7584:     #            $result .= &build_functionlist();
                   7585:     #}
                   7586: 
1.964     droeschl 7587:     # Don't add anything more if only_body wanted or in const space
                   7588:     return $result if    $args->{'only_body'} 
                   7589:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7590: 
                   7591:     #Breadcrumbs
1.758     kaisler  7592:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7593: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7594: 		#if any br links exists, add them to the breadcrumbs
                   7595: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7596: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7597: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7598: 			}
                   7599: 		}
1.1075.2.19  raeburn  7600:                 # if @advtools array contains items add then to the breadcrumbs
                   7601:                 if (@advtools > 0) {
                   7602:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7603:                 }
1.758     kaisler  7604: 
                   7605: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7606: 		if(exists($args->{'bread_crumbs_component'})){
                   7607: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7608: 		}else{
                   7609: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7610: 		}
1.1075.2.24  raeburn  7611:     } elsif (($env{'environment.remote'} eq 'on') &&
                   7612:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   7613:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   7614:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  7615:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 7616:     }
1.315     albertel 7617:     return $result;
1.306     albertel 7618: }
                   7619: 
                   7620: sub end_page {
1.315     albertel 7621:     my ($args) = @_;
                   7622:     $env{'internal.end_page'}++;
1.330     albertel 7623:     my $result;
1.335     albertel 7624:     if ($args->{'discussion'}) {
                   7625: 	my ($target,$parser);
                   7626: 	if (ref($args->{'discussion'})) {
                   7627: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7628: 				$args->{'discussion'}{'parser'});
                   7629: 	}
                   7630: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7631:     }
1.330     albertel 7632:     if ($args->{'frameset'}) {
                   7633: 	$result .= '</frameset>';
                   7634:     } else {
1.635     raeburn  7635: 	$result .= &endbodytag($args);
1.330     albertel 7636:     }
1.1075.2.6  raeburn  7637:     unless ($args->{'notbody'}) {
                   7638:         $result .= "\n</html>";
                   7639:     }
1.330     albertel 7640: 
1.315     albertel 7641:     if ($args->{'js_ready'}) {
1.317     albertel 7642: 	$result = &js_ready($result);
1.315     albertel 7643:     }
1.335     albertel 7644: 
1.320     albertel 7645:     if ($args->{'html_encode'}) {
                   7646: 	$result = &html_encode($result);
                   7647:     }
1.335     albertel 7648: 
1.315     albertel 7649:     return $result;
                   7650: }
                   7651: 
1.1034    www      7652: sub wishlist_window {
                   7653:     return(<<'ENDWISHLIST');
1.1046    raeburn  7654: <script type="text/javascript">
1.1034    www      7655: // <![CDATA[
                   7656: // <!-- BEGIN LON-CAPA Internal
                   7657: function set_wishlistlink(title, path) {
                   7658:     if (!title) {
                   7659:         title = document.title;
                   7660:         title = title.replace(/^LON-CAPA /,'');
                   7661:     }
1.1075.2.65  raeburn  7662:     title = encodeURIComponent(title);
1.1034    www      7663:     if (!path) {
                   7664:         path = location.pathname;
                   7665:     }
1.1075.2.65  raeburn  7666:     path = encodeURIComponent(path);
1.1034    www      7667:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7668:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7669: }
                   7670: // END LON-CAPA Internal -->
                   7671: // ]]>
                   7672: </script>
                   7673: ENDWISHLIST
                   7674: }
                   7675: 
1.1030    www      7676: sub modal_window {
                   7677:     return(<<'ENDMODAL');
1.1046    raeburn  7678: <script type="text/javascript">
1.1030    www      7679: // <![CDATA[
                   7680: // <!-- BEGIN LON-CAPA Internal
                   7681: var modalWindow = {
                   7682: 	parent:"body",
                   7683: 	windowId:null,
                   7684: 	content:null,
                   7685: 	width:null,
                   7686: 	height:null,
                   7687: 	close:function()
                   7688: 	{
                   7689: 	        $(".LCmodal-window").remove();
                   7690: 	        $(".LCmodal-overlay").remove();
                   7691: 	},
                   7692: 	open:function()
                   7693: 	{
                   7694: 		var modal = "";
                   7695: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7696: 		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;\">";
                   7697: 		modal += this.content;
                   7698: 		modal += "</div>";	
                   7699: 
                   7700: 		$(this.parent).append(modal);
                   7701: 
                   7702: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7703: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7704: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7705: 	}
                   7706: };
1.1075.2.42  raeburn  7707: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      7708: 	{
                   7709: 		modalWindow.windowId = "myModal";
                   7710: 		modalWindow.width = width;
                   7711: 		modalWindow.height = height;
1.1075.2.42  raeburn  7712: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'>&lt/iframe>";
1.1030    www      7713: 		modalWindow.open();
                   7714: 	};	
                   7715: // END LON-CAPA Internal -->
                   7716: // ]]>
                   7717: </script>
                   7718: ENDMODAL
                   7719: }
                   7720: 
                   7721: sub modal_link {
1.1075.2.42  raeburn  7722:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      7723:     unless ($width) { $width=480; }
                   7724:     unless ($height) { $height=400; }
1.1031    www      7725:     unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42  raeburn  7726:     unless ($transparency) { $transparency='true'; }
                   7727: 
1.1074    raeburn  7728:     my $target_attr;
                   7729:     if (defined($target)) {
                   7730:         $target_attr = 'target="'.$target.'"';
                   7731:     }
                   7732:     return <<"ENDLINK";
1.1075.2.42  raeburn  7733: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  7734:            $linktext</a>
                   7735: ENDLINK
1.1030    www      7736: }
                   7737: 
1.1032    www      7738: sub modal_adhoc_script {
                   7739:     my ($funcname,$width,$height,$content)=@_;
                   7740:     return (<<ENDADHOC);
1.1046    raeburn  7741: <script type="text/javascript">
1.1032    www      7742: // <![CDATA[
                   7743:         var $funcname = function()
                   7744:         {
                   7745:                 modalWindow.windowId = "myModal";
                   7746:                 modalWindow.width = $width;
                   7747:                 modalWindow.height = $height;
                   7748:                 modalWindow.content = '$content';
                   7749:                 modalWindow.open();
                   7750:         };  
                   7751: // ]]>
                   7752: </script>
                   7753: ENDADHOC
                   7754: }
                   7755: 
1.1041    www      7756: sub modal_adhoc_inner {
                   7757:     my ($funcname,$width,$height,$content)=@_;
                   7758:     my $innerwidth=$width-20;
                   7759:     $content=&js_ready(
1.1042    www      7760:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42  raeburn  7761:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   7762:                  $content.
1.1041    www      7763:                  &end_scrollbox().
1.1075.2.42  raeburn  7764:                  &end_page()
1.1041    www      7765:              );
                   7766:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7767: }
                   7768: 
                   7769: sub modal_adhoc_window {
                   7770:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7771:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7772:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7773: }
                   7774: 
                   7775: sub modal_adhoc_launch {
                   7776:     my ($funcname,$width,$height,$content)=@_;
                   7777:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7778: <script type="text/javascript">
                   7779: // <![CDATA[
                   7780: $funcname();
                   7781: // ]]>
                   7782: </script>
                   7783: ENDLAUNCH
                   7784: }
                   7785: 
                   7786: sub modal_adhoc_close {
                   7787:     return (<<ENDCLOSE);
                   7788: <script type="text/javascript">
                   7789: // <![CDATA[
                   7790: modalWindow.close();
                   7791: // ]]>
                   7792: </script>
                   7793: ENDCLOSE
                   7794: }
                   7795: 
1.1038    www      7796: sub togglebox_script {
                   7797:    return(<<ENDTOGGLE);
                   7798: <script type="text/javascript"> 
                   7799: // <![CDATA[
                   7800: function LCtoggleDisplay(id,hidetext,showtext) {
                   7801:    link = document.getElementById(id + "link").childNodes[0];
                   7802:    with (document.getElementById(id).style) {
                   7803:       if (display == "none" ) {
                   7804:           display = "inline";
                   7805:           link.nodeValue = hidetext;
                   7806:         } else {
                   7807:           display = "none";
                   7808:           link.nodeValue = showtext;
                   7809:        }
                   7810:    }
                   7811: }
                   7812: // ]]>
                   7813: </script>
                   7814: ENDTOGGLE
                   7815: }
                   7816: 
1.1039    www      7817: sub start_togglebox {
                   7818:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7819:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7820:     unless ($showtext) { $showtext=&mt('show'); }
                   7821:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7822:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7823:     return &start_data_table().
                   7824:            &start_data_table_header_row().
                   7825:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7826:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7827:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7828:            &end_data_table_header_row().
                   7829:            '<tr id="'.$id.'" style="display:none""><td>';
                   7830: }
                   7831: 
                   7832: sub end_togglebox {
                   7833:     return '</td></tr>'.&end_data_table();
                   7834: }
                   7835: 
1.1041    www      7836: sub LCprogressbar_script {
1.1045    www      7837:    my ($id)=@_;
1.1041    www      7838:    return(<<ENDPROGRESS);
                   7839: <script type="text/javascript">
                   7840: // <![CDATA[
1.1045    www      7841: \$('#progressbar$id').progressbar({
1.1041    www      7842:   value: 0,
                   7843:   change: function(event, ui) {
                   7844:     var newVal = \$(this).progressbar('option', 'value');
                   7845:     \$('.pblabel', this).text(LCprogressTxt);
                   7846:   }
                   7847: });
                   7848: // ]]>
                   7849: </script>
                   7850: ENDPROGRESS
                   7851: }
                   7852: 
                   7853: sub LCprogressbarUpdate_script {
                   7854:    return(<<ENDPROGRESSUPDATE);
                   7855: <style type="text/css">
                   7856: .ui-progressbar { position:relative; }
                   7857: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7858: </style>
                   7859: <script type="text/javascript">
                   7860: // <![CDATA[
1.1045    www      7861: var LCprogressTxt='---';
                   7862: 
                   7863: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7864:    LCprogressTxt=progresstext;
1.1045    www      7865:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7866: }
                   7867: // ]]>
                   7868: </script>
                   7869: ENDPROGRESSUPDATE
                   7870: }
                   7871: 
1.1042    www      7872: my $LClastpercent;
1.1045    www      7873: my $LCidcnt;
                   7874: my $LCcurrentid;
1.1042    www      7875: 
1.1041    www      7876: sub LCprogressbar {
1.1042    www      7877:     my ($r)=(@_);
                   7878:     $LClastpercent=0;
1.1045    www      7879:     $LCidcnt++;
                   7880:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7881:     my $starting=&mt('Starting');
                   7882:     my $content=(<<ENDPROGBAR);
1.1045    www      7883:   <div id="progressbar$LCcurrentid">
1.1041    www      7884:     <span class="pblabel">$starting</span>
                   7885:   </div>
                   7886: ENDPROGBAR
1.1045    www      7887:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7888: }
                   7889: 
                   7890: sub LCprogressbarUpdate {
1.1042    www      7891:     my ($r,$val,$text)=@_;
                   7892:     unless ($val) { 
                   7893:        if ($LClastpercent) {
                   7894:            $val=$LClastpercent;
                   7895:        } else {
                   7896:            $val=0;
                   7897:        }
                   7898:     }
1.1041    www      7899:     if ($val<0) { $val=0; }
                   7900:     if ($val>100) { $val=0; }
1.1042    www      7901:     $LClastpercent=$val;
1.1041    www      7902:     unless ($text) { $text=$val.'%'; }
                   7903:     $text=&js_ready($text);
1.1044    www      7904:     &r_print($r,<<ENDUPDATE);
1.1041    www      7905: <script type="text/javascript">
                   7906: // <![CDATA[
1.1045    www      7907: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7908: // ]]>
                   7909: </script>
                   7910: ENDUPDATE
1.1035    www      7911: }
                   7912: 
1.1042    www      7913: sub LCprogressbarClose {
                   7914:     my ($r)=@_;
                   7915:     $LClastpercent=0;
1.1044    www      7916:     &r_print($r,<<ENDCLOSE);
1.1042    www      7917: <script type="text/javascript">
                   7918: // <![CDATA[
1.1045    www      7919: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7920: // ]]>
                   7921: </script>
                   7922: ENDCLOSE
1.1044    www      7923: }
                   7924: 
                   7925: sub r_print {
                   7926:     my ($r,$to_print)=@_;
                   7927:     if ($r) {
                   7928:       $r->print($to_print);
                   7929:       $r->rflush();
                   7930:     } else {
                   7931:       print($to_print);
                   7932:     }
1.1042    www      7933: }
                   7934: 
1.320     albertel 7935: sub html_encode {
                   7936:     my ($result) = @_;
                   7937: 
1.322     albertel 7938:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7939:     
                   7940:     return $result;
                   7941: }
1.1044    www      7942: 
1.317     albertel 7943: sub js_ready {
                   7944:     my ($result) = @_;
                   7945: 
1.323     albertel 7946:     $result =~ s/[\n\r]/ /xmsg;
                   7947:     $result =~ s/\\/\\\\/xmsg;
                   7948:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7949:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7950:     
                   7951:     return $result;
                   7952: }
                   7953: 
1.315     albertel 7954: sub validate_page {
                   7955:     if (  exists($env{'internal.start_page'})
1.316     albertel 7956: 	  &&     $env{'internal.start_page'} > 1) {
                   7957: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7958: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7959: 				 $ENV{'request.filename'});
1.315     albertel 7960:     }
                   7961:     if (  exists($env{'internal.end_page'})
1.316     albertel 7962: 	  &&     $env{'internal.end_page'} > 1) {
                   7963: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7964: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7965: 				 $env{'request.filename'});
1.315     albertel 7966:     }
                   7967:     if (     exists($env{'internal.start_page'})
                   7968: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7969: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7970: 				 $env{'request.filename'});
1.315     albertel 7971:     }
                   7972:     if (   ! exists($env{'internal.start_page'})
                   7973: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7974: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7975: 				 $env{'request.filename'});
1.315     albertel 7976:     }
1.306     albertel 7977: }
1.315     albertel 7978: 
1.996     www      7979: 
                   7980: sub start_scrollbox {
1.1075.2.56  raeburn  7981:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  7982:     unless ($outerwidth) { $outerwidth='520px'; }
                   7983:     unless ($width) { $width='500px'; }
                   7984:     unless ($height) { $height='200px'; }
1.1075    raeburn  7985:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7986:     if ($id ne '') {
1.1075.2.42  raeburn  7987:         $table_id = ' id="table_'.$id.'"';
                   7988:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  7989:     }
1.1075    raeburn  7990:     if ($bgcolor ne '') {
                   7991:         $tdcol = "background-color: $bgcolor;";
                   7992:     }
1.1075.2.42  raeburn  7993:     my $nicescroll_js;
                   7994:     if ($env{'browser.mobile'}) {
                   7995:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   7996:     }
1.1075    raeburn  7997:     return <<"END";
1.1075.2.42  raeburn  7998: $nicescroll_js
                   7999: 
                   8000: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56  raeburn  8001: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075    raeburn  8002: END
1.996     www      8003: }
                   8004: 
                   8005: sub end_scrollbox {
1.1036    www      8006:     return '</div></td></tr></table>';
1.996     www      8007: }
                   8008: 
1.1075.2.42  raeburn  8009: sub nicescroll_javascript {
                   8010:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8011:     my %options;
                   8012:     if (ref($cursor) eq 'HASH') {
                   8013:         %options = %{$cursor};
                   8014:     }
                   8015:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8016:         $options{'railalign'} = 'left';
                   8017:     }
                   8018:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8019:         my $function  = &get_users_function();
                   8020:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
                   8021:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8022:             $options{'cursorcolor'} = '#00F';
                   8023:         }
                   8024:     }
                   8025:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8026:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
                   8027:             $options{'cursoropacity'}='1.0';
                   8028:         }
                   8029:     } else {
                   8030:         $options{'cursoropacity'}='1.0';
                   8031:     }
                   8032:     if ($options{'cursorfixedheight'} eq 'none') {
                   8033:         delete($options{'cursorfixedheight'});
                   8034:     } else {
                   8035:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8036:     }
                   8037:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8038:         delete($options{'railoffset'});
                   8039:     }
                   8040:     my @niceoptions;
                   8041:     while (my($key,$value) = each(%options)) {
                   8042:         if ($value =~ /^\{.+\}$/) {
                   8043:             push(@niceoptions,$key.':'.$value);
                   8044:         } else {
                   8045:             push(@niceoptions,$key.':"'.$value.'"');
                   8046:         }
                   8047:     }
                   8048:     my $nicescroll_js = '
                   8049: $(document).ready(
                   8050:       function() {
                   8051:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8052:       }
                   8053: );
                   8054: ';
                   8055:     if ($framecheck) {
                   8056:         $nicescroll_js .= '
                   8057: function expand_div(caller) {
                   8058:     if (top === self) {
                   8059:         document.getElementById("'.$id.'").style.width = "auto";
                   8060:         document.getElementById("'.$id.'").style.height = "auto";
                   8061:     } else {
                   8062:         try {
                   8063:             if (parent.frames) {
                   8064:                 if (parent.frames.length > 1) {
                   8065:                     var framesrc = parent.frames[1].location.href;
                   8066:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8067:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8068:                         document.getElementById("'.$id.'").style.width = "auto";
                   8069:                         document.getElementById("'.$id.'").style.height = "auto";
                   8070:                     }
                   8071:                 }
                   8072:             }
                   8073:         } catch (e) {
                   8074:             return;
                   8075:         }
                   8076:     }
                   8077:     return;
                   8078: }
                   8079: ';
                   8080:     }
                   8081:     if ($needjsready) {
                   8082:         $nicescroll_js = '
                   8083: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8084:     } else {
                   8085:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8086:     }
                   8087:     return $nicescroll_js;
                   8088: }
                   8089: 
1.318     albertel 8090: sub simple_error_page {
1.1075.2.49  raeburn  8091:     my ($r,$title,$msg,$args) = @_;
                   8092:     if (ref($args) eq 'HASH') {
                   8093:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8094:     } else {
                   8095:         $msg = &mt($msg);
                   8096:     }
                   8097: 
1.318     albertel 8098:     my $page =
                   8099: 	&Apache::loncommon::start_page($title).
1.1075.2.49  raeburn  8100: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8101: 	&Apache::loncommon::end_page();
                   8102:     if (ref($r)) {
                   8103: 	$r->print($page);
1.327     albertel 8104: 	return;
1.318     albertel 8105:     }
                   8106:     return $page;
                   8107: }
1.347     albertel 8108: 
                   8109: {
1.610     albertel 8110:     my @row_count;
1.961     onken    8111: 
                   8112:     sub start_data_table_count {
                   8113:         unshift(@row_count, 0);
                   8114:         return;
                   8115:     }
                   8116: 
                   8117:     sub end_data_table_count {
                   8118:         shift(@row_count);
                   8119:         return;
                   8120:     }
                   8121: 
1.347     albertel 8122:     sub start_data_table {
1.1018    raeburn  8123: 	my ($add_class,$id) = @_;
1.422     albertel 8124: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8125:         my $table_id;
                   8126:         if (defined($id)) {
                   8127:             $table_id = ' id="'.$id.'"';
                   8128:         }
1.961     onken    8129: 	&start_data_table_count();
1.1018    raeburn  8130: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8131:     }
                   8132: 
                   8133:     sub end_data_table {
1.961     onken    8134: 	&end_data_table_count();
1.389     albertel 8135: 	return '</table>'."\n";;
1.347     albertel 8136:     }
                   8137: 
                   8138:     sub start_data_table_row {
1.974     wenzelju 8139: 	my ($add_class, $id) = @_;
1.610     albertel 8140: 	$row_count[0]++;
                   8141: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8142: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8143:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8144:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8145:     }
1.471     banghart 8146:     
                   8147:     sub continue_data_table_row {
1.974     wenzelju 8148: 	my ($add_class, $id) = @_;
1.610     albertel 8149: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8150: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8151:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8152:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8153:     }
1.347     albertel 8154: 
                   8155:     sub end_data_table_row {
1.389     albertel 8156: 	return '</tr>'."\n";;
1.347     albertel 8157:     }
1.367     www      8158: 
1.421     albertel 8159:     sub start_data_table_empty_row {
1.707     bisitz   8160: #	$row_count[0]++;
1.421     albertel 8161: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8162:     }
                   8163: 
                   8164:     sub end_data_table_empty_row {
                   8165: 	return '</tr>'."\n";;
                   8166:     }
                   8167: 
1.367     www      8168:     sub start_data_table_header_row {
1.389     albertel 8169: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8170:     }
                   8171: 
                   8172:     sub end_data_table_header_row {
1.389     albertel 8173: 	return '</tr>'."\n";;
1.367     www      8174:     }
1.890     droeschl 8175: 
                   8176:     sub data_table_caption {
                   8177:         my $caption = shift;
                   8178:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8179:     }
1.347     albertel 8180: }
                   8181: 
1.548     albertel 8182: =pod
                   8183: 
                   8184: =item * &inhibit_menu_check($arg)
                   8185: 
                   8186: Checks for a inhibitmenu state and generates output to preserve it
                   8187: 
                   8188: Inputs:         $arg - can be any of
                   8189:                      - undef - in which case the return value is a string 
                   8190:                                to add  into arguments list of a uri
                   8191:                      - 'input' - in which case the return value is a HTML
                   8192:                                  <form> <input> field of type hidden to
                   8193:                                  preserve the value
                   8194:                      - a url - in which case the return value is the url with
                   8195:                                the neccesary cgi args added to preserve the
                   8196:                                inhibitmenu state
                   8197:                      - a ref to a url - no return value, but the string is
                   8198:                                         updated to include the neccessary cgi
                   8199:                                         args to preserve the inhibitmenu state
                   8200: 
                   8201: =cut
                   8202: 
                   8203: sub inhibit_menu_check {
                   8204:     my ($arg) = @_;
                   8205:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8206:     if ($arg eq 'input') {
                   8207: 	if ($env{'form.inhibitmenu'}) {
                   8208: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8209: 	} else {
                   8210: 	    return
                   8211: 	}
                   8212:     }
                   8213:     if ($env{'form.inhibitmenu'}) {
                   8214: 	if (ref($arg)) {
                   8215: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8216: 	} elsif ($arg eq '') {
                   8217: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8218: 	} else {
                   8219: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8220: 	}
                   8221:     }
                   8222:     if (!ref($arg)) {
                   8223: 	return $arg;
                   8224:     }
                   8225: }
                   8226: 
1.251     albertel 8227: ###############################################
1.182     matthew  8228: 
                   8229: =pod
                   8230: 
1.549     albertel 8231: =back
                   8232: 
                   8233: =head1 User Information Routines
                   8234: 
                   8235: =over 4
                   8236: 
1.405     albertel 8237: =item * &get_users_function()
1.182     matthew  8238: 
                   8239: Used by &bodytag to determine the current users primary role.
                   8240: Returns either 'student','coordinator','admin', or 'author'.
                   8241: 
                   8242: =cut
                   8243: 
                   8244: ###############################################
                   8245: sub get_users_function {
1.815     tempelho 8246:     my $function = 'norole';
1.818     tempelho 8247:     if ($env{'request.role'}=~/^(st)/) {
                   8248:         $function='student';
                   8249:     }
1.907     raeburn  8250:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8251:         $function='coordinator';
                   8252:     }
1.258     albertel 8253:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8254:         $function='admin';
                   8255:     }
1.826     bisitz   8256:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8257:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8258:         $function='author';
                   8259:     }
                   8260:     return $function;
1.54      www      8261: }
1.99      www      8262: 
                   8263: ###############################################
                   8264: 
1.233     raeburn  8265: =pod
                   8266: 
1.821     raeburn  8267: =item * &show_course()
                   8268: 
                   8269: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8270: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8271: 
                   8272: Inputs:
                   8273: None
                   8274: 
                   8275: Outputs:
                   8276: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8277: 
                   8278: =cut
                   8279: 
                   8280: ###############################################
                   8281: sub show_course {
                   8282:     my $course = !$env{'user.adv'};
                   8283:     if (!$env{'user.adv'}) {
                   8284:         foreach my $env (keys(%env)) {
                   8285:             next if ($env !~ m/^user\.priv\./);
                   8286:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8287:                 $course = 0;
                   8288:                 last;
                   8289:             }
                   8290:         }
                   8291:     }
                   8292:     return $course;
                   8293: }
                   8294: 
                   8295: ###############################################
                   8296: 
                   8297: =pod
                   8298: 
1.542     raeburn  8299: =item * &check_user_status()
1.274     raeburn  8300: 
                   8301: Determines current status of supplied role for a
                   8302: specific user. Roles can be active, previous or future.
                   8303: 
                   8304: Inputs: 
                   8305: user's domain, user's username, course's domain,
1.375     raeburn  8306: course's number, optional section ID.
1.274     raeburn  8307: 
                   8308: Outputs:
                   8309: role status: active, previous or future. 
                   8310: 
                   8311: =cut
                   8312: 
                   8313: sub check_user_status {
1.412     raeburn  8314:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8315:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8316:     my @uroles = keys %userinfo;
                   8317:     my $srchstr;
                   8318:     my $active_chk = 'none';
1.412     raeburn  8319:     my $now = time;
1.274     raeburn  8320:     if (@uroles > 0) {
1.908     raeburn  8321:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8322:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8323:         } else {
1.412     raeburn  8324:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8325:         }
                   8326:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8327:             my $role_end = 0;
                   8328:             my $role_start = 0;
                   8329:             $active_chk = 'active';
1.412     raeburn  8330:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8331:                 $role_end = $1;
                   8332:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8333:                     $role_start = $1;
1.274     raeburn  8334:                 }
                   8335:             }
                   8336:             if ($role_start > 0) {
1.412     raeburn  8337:                 if ($now < $role_start) {
1.274     raeburn  8338:                     $active_chk = 'future';
                   8339:                 }
                   8340:             }
                   8341:             if ($role_end > 0) {
1.412     raeburn  8342:                 if ($now > $role_end) {
1.274     raeburn  8343:                     $active_chk = 'previous';
                   8344:                 }
                   8345:             }
                   8346:         }
                   8347:     }
                   8348:     return $active_chk;
                   8349: }
                   8350: 
                   8351: ###############################################
                   8352: 
                   8353: =pod
                   8354: 
1.405     albertel 8355: =item * &get_sections()
1.233     raeburn  8356: 
                   8357: Determines all the sections for a course including
                   8358: sections with students and sections containing other roles.
1.419     raeburn  8359: Incoming parameters: 
                   8360: 
                   8361: 1. domain
                   8362: 2. course number 
                   8363: 3. reference to array containing roles for which sections should 
                   8364: be gathered (optional).
                   8365: 4. reference to array containing status types for which sections 
                   8366: should be gathered (optional).
                   8367: 
                   8368: If the third argument is undefined, sections are gathered for any role. 
                   8369: If the fourth argument is undefined, sections are gathered for any status.
                   8370: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8371:  
1.374     raeburn  8372: Returns section hash (keys are section IDs, values are
                   8373: number of users in each section), subject to the
1.419     raeburn  8374: optional roles filter, optional status filter 
1.233     raeburn  8375: 
                   8376: =cut
                   8377: 
                   8378: ###############################################
                   8379: sub get_sections {
1.419     raeburn  8380:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8381:     if (!defined($cdom) || !defined($cnum)) {
                   8382:         my $cid =  $env{'request.course.id'};
                   8383: 
                   8384: 	return if (!defined($cid));
                   8385: 
                   8386:         $cdom = $env{'course.'.$cid.'.domain'};
                   8387:         $cnum = $env{'course.'.$cid.'.num'};
                   8388:     }
                   8389: 
                   8390:     my %sectioncount;
1.419     raeburn  8391:     my $now = time;
1.240     albertel 8392: 
1.1075.2.33  raeburn  8393:     my $check_students = 1;
                   8394:     my $only_students = 0;
                   8395:     if (ref($possible_roles) eq 'ARRAY') {
                   8396:         if (grep(/^st$/,@{$possible_roles})) {
                   8397:             if (@{$possible_roles} == 1) {
                   8398:                 $only_students = 1;
                   8399:             }
                   8400:         } else {
                   8401:             $check_students = 0;
                   8402:         }
                   8403:     }
                   8404: 
                   8405:     if ($check_students) {
1.276     albertel 8406: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8407: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8408: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8409:         my $start_index = &Apache::loncoursedata::CL_START();
                   8410:         my $end_index = &Apache::loncoursedata::CL_END();
                   8411:         my $status;
1.366     albertel 8412: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8413: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8414: 				                     $data->[$status_index],
                   8415:                                                      $data->[$start_index],
                   8416:                                                      $data->[$end_index]);
                   8417:             if ($stu_status eq 'Active') {
                   8418:                 $status = 'active';
                   8419:             } elsif ($end < $now) {
                   8420:                 $status = 'previous';
                   8421:             } elsif ($start > $now) {
                   8422:                 $status = 'future';
                   8423:             } 
                   8424: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8425:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8426:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8427: 		    $sectioncount{$section}++;
                   8428:                 }
1.240     albertel 8429: 	    }
                   8430: 	}
                   8431:     }
1.1075.2.33  raeburn  8432:     if ($only_students) {
                   8433:         return %sectioncount;
                   8434:     }
1.240     albertel 8435:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8436:     foreach my $user (sort(keys(%courseroles))) {
                   8437: 	if ($user !~ /^(\w{2})/) { next; }
                   8438: 	my ($role) = ($user =~ /^(\w{2})/);
                   8439: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8440: 	my ($section,$status);
1.240     albertel 8441: 	if ($role eq 'cr' &&
                   8442: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8443: 	    $section=$1;
                   8444: 	}
                   8445: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8446: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8447:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8448:         if ($end == -1 && $start == -1) {
                   8449:             next; #deleted role
                   8450:         }
                   8451:         if (!defined($possible_status)) { 
                   8452:             $sectioncount{$section}++;
                   8453:         } else {
                   8454:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8455:                 $status = 'active';
                   8456:             } elsif ($end < $now) {
                   8457:                 $status = 'future';
                   8458:             } elsif ($start > $now) {
                   8459:                 $status = 'previous';
                   8460:             }
                   8461:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8462:                 $sectioncount{$section}++;
                   8463:             }
                   8464:         }
1.233     raeburn  8465:     }
1.366     albertel 8466:     return %sectioncount;
1.233     raeburn  8467: }
                   8468: 
1.274     raeburn  8469: ###############################################
1.294     raeburn  8470: 
                   8471: =pod
1.405     albertel 8472: 
                   8473: =item * &get_course_users()
                   8474: 
1.275     raeburn  8475: Retrieves usernames:domains for users in the specified course
                   8476: with specific role(s), and access status. 
                   8477: 
                   8478: Incoming parameters:
1.277     albertel 8479: 1. course domain
                   8480: 2. course number
                   8481: 3. access status: users must have - either active, 
1.275     raeburn  8482: previous, future, or all.
1.277     albertel 8483: 4. reference to array of permissible roles
1.288     raeburn  8484: 5. reference to array of section restrictions (optional)
                   8485: 6. reference to results object (hash of hashes).
                   8486: 7. reference to optional userdata hash
1.609     raeburn  8487: 8. reference to optional statushash
1.630     raeburn  8488: 9. flag if privileged users (except those set to unhide in
                   8489:    course settings) should be excluded    
1.609     raeburn  8490: Keys of top level results hash are roles.
1.275     raeburn  8491: Keys of inner hashes are username:domain, with 
                   8492: values set to access type.
1.288     raeburn  8493: Optional userdata hash returns an array with arguments in the 
                   8494: same order as loncoursedata::get_classlist() for student data.
                   8495: 
1.609     raeburn  8496: Optional statushash returns
                   8497: 
1.288     raeburn  8498: Entries for end, start, section and status are blank because
                   8499: of the possibility of multiple values for non-student roles.
                   8500: 
1.275     raeburn  8501: =cut
1.405     albertel 8502: 
1.275     raeburn  8503: ###############################################
1.405     albertel 8504: 
1.275     raeburn  8505: sub get_course_users {
1.630     raeburn  8506:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8507:     my %idx = ();
1.419     raeburn  8508:     my %seclists;
1.288     raeburn  8509: 
                   8510:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8511:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8512:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8513:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8514:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8515:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8516:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8517:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8518: 
1.290     albertel 8519:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8520:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8521:         my $now = time;
1.277     albertel 8522:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8523:             my $match = 0;
1.412     raeburn  8524:             my $secmatch = 0;
1.419     raeburn  8525:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8526:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8527:             if ($section eq '') {
                   8528:                 $section = 'none';
                   8529:             }
1.291     albertel 8530:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8531:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8532:                     $secmatch = 1;
                   8533:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8534:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8535:                         $secmatch = 1;
                   8536:                     }
                   8537:                 } else {  
1.419     raeburn  8538: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8539: 		        $secmatch = 1;
                   8540:                     }
1.290     albertel 8541: 		}
1.412     raeburn  8542:                 if (!$secmatch) {
                   8543:                     next;
                   8544:                 }
1.419     raeburn  8545:             }
1.275     raeburn  8546:             if (defined($$types{'active'})) {
1.288     raeburn  8547:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8548:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8549:                     $match = 1;
1.275     raeburn  8550:                 }
                   8551:             }
                   8552:             if (defined($$types{'previous'})) {
1.609     raeburn  8553:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8554:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8555:                     $match = 1;
1.275     raeburn  8556:                 }
                   8557:             }
                   8558:             if (defined($$types{'future'})) {
1.609     raeburn  8559:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8560:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8561:                     $match = 1;
1.275     raeburn  8562:                 }
                   8563:             }
1.609     raeburn  8564:             if ($match) {
                   8565:                 push(@{$seclists{$student}},$section);
                   8566:                 if (ref($userdata) eq 'HASH') {
                   8567:                     $$userdata{$student} = $$classlist{$student};
                   8568:                 }
                   8569:                 if (ref($statushash) eq 'HASH') {
                   8570:                     $statushash->{$student}{'st'}{$section} = $status;
                   8571:                 }
1.288     raeburn  8572:             }
1.275     raeburn  8573:         }
                   8574:     }
1.412     raeburn  8575:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8576:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8577:         my $now = time;
1.609     raeburn  8578:         my %displaystatus = ( previous => 'Expired',
                   8579:                               active   => 'Active',
                   8580:                               future   => 'Future',
                   8581:                             );
1.1075.2.36  raeburn  8582:         my (%nothide,@possdoms);
1.630     raeburn  8583:         if ($hidepriv) {
                   8584:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8585:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8586:                 if ($user !~ /:/) {
                   8587:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8588:                 } else {
                   8589:                     $nothide{$user} = 1;
                   8590:                 }
                   8591:             }
1.1075.2.36  raeburn  8592:             my @possdoms = ($cdom);
                   8593:             if ($coursehash{'checkforpriv'}) {
                   8594:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   8595:             }
1.630     raeburn  8596:         }
1.439     raeburn  8597:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8598:             my $match = 0;
1.412     raeburn  8599:             my $secmatch = 0;
1.439     raeburn  8600:             my $status;
1.412     raeburn  8601:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8602:             $user =~ s/:$//;
1.439     raeburn  8603:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8604:             if ($end == -1 || $start == -1) {
                   8605:                 next;
                   8606:             }
                   8607:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8608:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8609:                 my ($uname,$udom) = split(/:/,$user);
                   8610:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8611:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8612:                         $secmatch = 1;
                   8613:                     } elsif ($usec eq '') {
1.420     albertel 8614:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8615:                             $secmatch = 1;
                   8616:                         }
                   8617:                     } else {
                   8618:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8619:                             $secmatch = 1;
                   8620:                         }
                   8621:                     }
                   8622:                     if (!$secmatch) {
                   8623:                         next;
                   8624:                     }
1.288     raeburn  8625:                 }
1.419     raeburn  8626:                 if ($usec eq '') {
                   8627:                     $usec = 'none';
                   8628:                 }
1.275     raeburn  8629:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8630:                     if ($hidepriv) {
1.1075.2.36  raeburn  8631:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  8632:                             (!$nothide{$uname.':'.$udom})) {
                   8633:                             next;
                   8634:                         }
                   8635:                     }
1.503     raeburn  8636:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8637:                         $status = 'previous';
                   8638:                     } elsif ($start > $now) {
                   8639:                         $status = 'future';
                   8640:                     } else {
                   8641:                         $status = 'active';
                   8642:                     }
1.277     albertel 8643:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8644:                         if ($status eq $type) {
1.420     albertel 8645:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8646:                                 push(@{$$users{$role}{$user}},$type);
                   8647:                             }
1.288     raeburn  8648:                             $match = 1;
                   8649:                         }
                   8650:                     }
1.419     raeburn  8651:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8652:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8653: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8654:                         }
1.420     albertel 8655:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8656:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8657:                         }
1.609     raeburn  8658:                         if (ref($statushash) eq 'HASH') {
                   8659:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8660:                         }
1.275     raeburn  8661:                     }
                   8662:                 }
                   8663:             }
                   8664:         }
1.290     albertel 8665:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8666:             if ((defined($cdom)) && (defined($cnum))) {
                   8667:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8668:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8669:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8670:                     next if ($owner eq '');
                   8671:                     my ($ownername,$ownerdom);
                   8672:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8673:                         $ownername = $1;
                   8674:                         $ownerdom = $2;
                   8675:                     } else {
                   8676:                         $ownername = $owner;
                   8677:                         $ownerdom = $cdom;
                   8678:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8679:                     }
                   8680:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8681:                     if (defined($userdata) && 
1.609     raeburn  8682: 			!exists($$userdata{$owner})) {
                   8683: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8684:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8685:                             push(@{$seclists{$owner}},'none');
                   8686:                         }
                   8687:                         if (ref($statushash) eq 'HASH') {
                   8688:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8689:                         }
1.290     albertel 8690: 		    }
1.279     raeburn  8691:                 }
                   8692:             }
                   8693:         }
1.419     raeburn  8694:         foreach my $user (keys(%seclists)) {
                   8695:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8696:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8697:         }
1.275     raeburn  8698:     }
                   8699:     return;
                   8700: }
                   8701: 
1.288     raeburn  8702: sub get_user_info {
                   8703:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8704:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8705: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8706:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8707:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8708:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8709:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8710:     return;
                   8711: }
1.275     raeburn  8712: 
1.472     raeburn  8713: ###############################################
                   8714: 
                   8715: =pod
                   8716: 
                   8717: =item * &get_user_quota()
                   8718: 
1.1075.2.41  raeburn  8719: Retrieves quota assigned for storage of user files.
                   8720: Default is to report quota for portfolio files.
1.472     raeburn  8721: 
                   8722: Incoming parameters:
                   8723: 1. user's username
                   8724: 2. user's domain
1.1075.2.41  raeburn  8725: 3. quota name - portfolio, author, or course
                   8726:    (if no quota name provided, defaults to portfolio).
1.1075.2.59  raeburn  8727: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42  raeburn  8728:    course
1.472     raeburn  8729: 
                   8730: Returns:
1.1075.2.58  raeburn  8731: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  8732: 2. (Optional) Type of setting: custom or default
                   8733:    (individually assigned or default for user's 
                   8734:    institutional status).
                   8735: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8736:    or student - types as defined in localenroll::inst_usertypes 
                   8737:    for user's domain, which determines default quota for user.
                   8738: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8739: 
                   8740: If a value has been stored in the user's environment, 
1.536     raeburn  8741: it will return that, otherwise it returns the maximal default
1.1075.2.41  raeburn  8742: defined for the user's institutional status(es) in the domain.
1.472     raeburn  8743: 
                   8744: =cut
                   8745: 
                   8746: ###############################################
                   8747: 
                   8748: 
                   8749: sub get_user_quota {
1.1075.2.42  raeburn  8750:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  8751:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8752:     if (!defined($udom)) {
                   8753:         $udom = $env{'user.domain'};
                   8754:     }
                   8755:     if (!defined($uname)) {
                   8756:         $uname = $env{'user.name'};
                   8757:     }
                   8758:     if (($udom eq '' || $uname eq '') ||
                   8759:         ($udom eq 'public') && ($uname eq 'public')) {
                   8760:         $quota = 0;
1.536     raeburn  8761:         $quotatype = 'default';
                   8762:         $defquota = 0; 
1.472     raeburn  8763:     } else {
1.536     raeburn  8764:         my $inststatus;
1.1075.2.41  raeburn  8765:         if ($quotaname eq 'course') {
                   8766:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   8767:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   8768:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   8769:             } else {
                   8770:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   8771:                 $quota = $cenv{'internal.uploadquota'};
                   8772:             }
1.536     raeburn  8773:         } else {
1.1075.2.41  raeburn  8774:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8775:                 if ($quotaname eq 'author') {
                   8776:                     $quota = $env{'environment.authorquota'};
                   8777:                 } else {
                   8778:                     $quota = $env{'environment.portfolioquota'};
                   8779:                 }
                   8780:                 $inststatus = $env{'environment.inststatus'};
                   8781:             } else {
                   8782:                 my %userenv = 
                   8783:                     &Apache::lonnet::get('environment',['portfolioquota',
                   8784:                                          'authorquota','inststatus'],$udom,$uname);
                   8785:                 my ($tmp) = keys(%userenv);
                   8786:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8787:                     if ($quotaname eq 'author') {
                   8788:                         $quota = $userenv{'authorquota'};
                   8789:                     } else {
                   8790:                         $quota = $userenv{'portfolioquota'};
                   8791:                     }
                   8792:                     $inststatus = $userenv{'inststatus'};
                   8793:                 } else {
                   8794:                     undef(%userenv);
                   8795:                 }
                   8796:             }
                   8797:         }
                   8798:         if ($quota eq '' || wantarray) {
                   8799:             if ($quotaname eq 'course') {
                   8800:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59  raeburn  8801:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
                   8802:                     ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42  raeburn  8803:                     $defquota = $domdefs{$crstype.'quota'};
                   8804:                 }
                   8805:                 if ($defquota eq '') {
                   8806:                     $defquota = 500;
                   8807:                 }
1.1075.2.41  raeburn  8808:             } else {
                   8809:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   8810:             }
                   8811:             if ($quota eq '') {
                   8812:                 $quota = $defquota;
                   8813:                 $quotatype = 'default';
                   8814:             } else {
                   8815:                 $quotatype = 'custom';
                   8816:             }
1.472     raeburn  8817:         }
                   8818:     }
1.536     raeburn  8819:     if (wantarray) {
                   8820:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8821:     } else {
                   8822:         return $quota;
                   8823:     }
1.472     raeburn  8824: }
                   8825: 
                   8826: ###############################################
                   8827: 
                   8828: =pod
                   8829: 
                   8830: =item * &default_quota()
                   8831: 
1.536     raeburn  8832: Retrieves default quota assigned for storage of user portfolio files,
                   8833: given an (optional) user's institutional status.
1.472     raeburn  8834: 
                   8835: Incoming parameters:
1.1075.2.42  raeburn  8836: 
1.472     raeburn  8837: 1. domain
1.536     raeburn  8838: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8839:    status types (e.g., faculty, staff, student etc.)
                   8840:    which apply to the user for whom the default is being retrieved.
                   8841:    If the institutional status string in undefined, the domain
1.1075.2.41  raeburn  8842:    default quota will be returned.
                   8843: 3.  quota name - portfolio, author, or course
                   8844:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  8845: 
                   8846: Returns:
1.1075.2.42  raeburn  8847: 
1.1075.2.58  raeburn  8848: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  8849: 2. (Optional) institutional type which determined the value of the
                   8850:    default quota.
1.472     raeburn  8851: 
                   8852: If a value has been stored in the domain's configuration db,
                   8853: it will return that, otherwise it returns 20 (for backwards 
                   8854: compatibility with domains which have not set up a configuration
1.1075.2.58  raeburn  8855: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  8856: 
1.536     raeburn  8857: If the user's status includes multiple types (e.g., staff and student),
                   8858: the largest default quota which applies to the user determines the
                   8859: default quota returned.
                   8860: 
1.472     raeburn  8861: =cut
                   8862: 
                   8863: ###############################################
                   8864: 
                   8865: 
                   8866: sub default_quota {
1.1075.2.41  raeburn  8867:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  8868:     my ($defquota,$settingstatus);
                   8869:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8870:                                             ['quotas'],$udom);
1.1075.2.41  raeburn  8871:     my $key = 'defaultquota';
                   8872:     if ($quotaname eq 'author') {
                   8873:         $key = 'authorquota';
                   8874:     }
1.622     raeburn  8875:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8876:         if ($inststatus ne '') {
1.765     raeburn  8877:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8878:             foreach my $item (@statuses) {
1.1075.2.41  raeburn  8879:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8880:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  8881:                         if ($defquota eq '') {
1.1075.2.41  raeburn  8882:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8883:                             $settingstatus = $item;
1.1075.2.41  raeburn  8884:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   8885:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8886:                             $settingstatus = $item;
                   8887:                         }
                   8888:                     }
1.1075.2.41  raeburn  8889:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  8890:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8891:                         if ($defquota eq '') {
                   8892:                             $defquota = $quotahash{'quotas'}{$item};
                   8893:                             $settingstatus = $item;
                   8894:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8895:                             $defquota = $quotahash{'quotas'}{$item};
                   8896:                             $settingstatus = $item;
                   8897:                         }
1.536     raeburn  8898:                     }
                   8899:                 }
                   8900:             }
                   8901:         }
                   8902:         if ($defquota eq '') {
1.1075.2.41  raeburn  8903:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8904:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   8905:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  8906:                 $defquota = $quotahash{'quotas'}{'default'};
                   8907:             }
1.536     raeburn  8908:             $settingstatus = 'default';
1.1075.2.42  raeburn  8909:             if ($defquota eq '') {
                   8910:                 if ($quotaname eq 'author') {
                   8911:                     $defquota = 500;
                   8912:                 }
                   8913:             }
1.536     raeburn  8914:         }
                   8915:     } else {
                   8916:         $settingstatus = 'default';
1.1075.2.41  raeburn  8917:         if ($quotaname eq 'author') {
                   8918:             $defquota = 500;
                   8919:         } else {
                   8920:             $defquota = 20;
                   8921:         }
1.536     raeburn  8922:     }
                   8923:     if (wantarray) {
                   8924:         return ($defquota,$settingstatus);
1.472     raeburn  8925:     } else {
1.536     raeburn  8926:         return $defquota;
1.472     raeburn  8927:     }
                   8928: }
                   8929: 
1.1075.2.41  raeburn  8930: ###############################################
                   8931: 
                   8932: =pod
                   8933: 
1.1075.2.42  raeburn  8934: =item * &excess_filesize_warning()
1.1075.2.41  raeburn  8935: 
                   8936: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42  raeburn  8937: of existing file within authoring space will cause quota for the authoring
                   8938: space to be exceeded.
                   8939: 
                   8940: Same, if upload of a file directly to a course/community via Course Editor
                   8941: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41  raeburn  8942: 
1.1075.2.61  raeburn  8943: Inputs: 7 
1.1075.2.42  raeburn  8944: 1. username or coursenum
1.1075.2.41  raeburn  8945: 2. domain
1.1075.2.42  raeburn  8946: 3. context ('author' or 'course')
1.1075.2.41  raeburn  8947: 4. filename of file for which action is being requested
                   8948: 5. filesize (kB) of file
                   8949: 6. action being taken: copy or upload.
1.1075.2.59  raeburn  8950: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41  raeburn  8951: 
                   8952: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
                   8953:          otherwise return null.
                   8954: 
1.1075.2.42  raeburn  8955: =back
                   8956: 
1.1075.2.41  raeburn  8957: =cut
                   8958: 
1.1075.2.42  raeburn  8959: sub excess_filesize_warning {
1.1075.2.59  raeburn  8960:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42  raeburn  8961:     my $current_disk_usage = 0;
1.1075.2.59  raeburn  8962:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42  raeburn  8963:     if ($context eq 'author') {
                   8964:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   8965:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   8966:     } else {
                   8967:         foreach my $subdir ('docs','supplemental') {
                   8968:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   8969:         }
                   8970:     }
1.1075.2.41  raeburn  8971:     $disk_quota = int($disk_quota * 1000);
                   8972:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69  raeburn  8973:         return '<p class="LC_warning">'.
1.1075.2.41  raeburn  8974:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69  raeburn  8975:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   8976:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41  raeburn  8977:                             $disk_quota,$current_disk_usage).
                   8978:                '</p>';
                   8979:     }
                   8980:     return;
                   8981: }
                   8982: 
                   8983: ###############################################
                   8984: 
                   8985: 
1.384     raeburn  8986: sub get_secgrprole_info {
                   8987:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8988:     my %sections_count = &get_sections($cdom,$cnum);
                   8989:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8990:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8991:     my @groups = sort(keys(%curr_groups));
                   8992:     my $allroles = [];
                   8993:     my $rolehash;
                   8994:     my $accesshash = {
                   8995:                      active => 'Currently has access',
                   8996:                      future => 'Will have future access',
                   8997:                      previous => 'Previously had access',
                   8998:                   };
                   8999:     if ($needroles) {
                   9000:         $rolehash = {'all' => 'all'};
1.385     albertel 9001:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9002: 	if (&Apache::lonnet::error(%user_roles)) {
                   9003: 	    undef(%user_roles);
                   9004: 	}
                   9005:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9006:             my ($role)=split(/\:/,$item,2);
                   9007:             if ($role eq 'cr') { next; }
                   9008:             if ($role =~ /^cr/) {
                   9009:                 $$rolehash{$role} = (split('/',$role))[3];
                   9010:             } else {
                   9011:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9012:             }
                   9013:         }
                   9014:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9015:             push(@{$allroles},$key);
                   9016:         }
                   9017:         push (@{$allroles},'st');
                   9018:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9019:     }
                   9020:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9021: }
                   9022: 
1.555     raeburn  9023: sub user_picker {
1.994     raeburn  9024:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  9025:     my $currdom = $dom;
                   9026:     my %curr_selected = (
                   9027:                         srchin => 'dom',
1.580     raeburn  9028:                         srchby => 'lastname',
1.555     raeburn  9029:                       );
                   9030:     my $srchterm;
1.625     raeburn  9031:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9032:         if ($srch->{'srchby'} ne '') {
                   9033:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9034:         }
                   9035:         if ($srch->{'srchin'} ne '') {
                   9036:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9037:         }
                   9038:         if ($srch->{'srchtype'} ne '') {
                   9039:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9040:         }
                   9041:         if ($srch->{'srchdomain'} ne '') {
                   9042:             $currdom = $srch->{'srchdomain'};
                   9043:         }
                   9044:         $srchterm = $srch->{'srchterm'};
                   9045:     }
                   9046:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  9047:                     'usr'       => 'Search criteria',
1.563     raeburn  9048:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9049:                     'uname'     => 'username',
                   9050:                     'lastname'  => 'last name',
1.555     raeburn  9051:                     'lastfirst' => 'last name, first name',
1.558     albertel 9052:                     'crs'       => 'in this course',
1.576     raeburn  9053:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9054:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9055:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9056:                     'exact'     => 'is',
                   9057:                     'contains'  => 'contains',
1.569     raeburn  9058:                     'begins'    => 'begins with',
1.571     raeburn  9059:                     'youm'      => "You must include some text to search for.",
                   9060:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9061:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9062:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9063:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9064:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9065:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9066:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9067:                                        );
1.563     raeburn  9068:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9069:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9070: 
                   9071:     my @srchins = ('crs','dom','alc','instd');
                   9072: 
                   9073:     foreach my $option (@srchins) {
                   9074:         # FIXME 'alc' option unavailable until 
                   9075:         #       loncreateuser::print_user_query_page()
                   9076:         #       has been completed.
                   9077:         next if ($option eq 'alc');
1.880     raeburn  9078:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9079:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9080:         if ($curr_selected{'srchin'} eq $option) {
                   9081:             $srchinsel .= ' 
                   9082:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9083:         } else {
                   9084:             $srchinsel .= '
                   9085:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9086:         }
1.555     raeburn  9087:     }
1.563     raeburn  9088:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9089: 
                   9090:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9091:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9092:         if ($curr_selected{'srchby'} eq $option) {
                   9093:             $srchbysel .= '
                   9094:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9095:         } else {
                   9096:             $srchbysel .= '
                   9097:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9098:          }
                   9099:     }
                   9100:     $srchbysel .= "\n  </select>\n";
                   9101: 
                   9102:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9103:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9104:         if ($curr_selected{'srchtype'} eq $option) {
                   9105:             $srchtypesel .= '
                   9106:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9107:         } else {
                   9108:             $srchtypesel .= '
                   9109:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9110:         }
                   9111:     }
                   9112:     $srchtypesel .= "\n  </select>\n";
                   9113: 
1.558     albertel 9114:     my ($newuserscript,$new_user_create);
1.994     raeburn  9115:     my $context_dom = $env{'request.role.domain'};
                   9116:     if ($context eq 'requestcrs') {
                   9117:         if ($env{'form.coursedom'} ne '') { 
                   9118:             $context_dom = $env{'form.coursedom'};
                   9119:         }
                   9120:     }
1.556     raeburn  9121:     if ($forcenewuser) {
1.576     raeburn  9122:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9123:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9124:                 if ($cancreate) {
                   9125:                     $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>';
                   9126:                 } else {
1.799     bisitz   9127:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9128:                     my %usertypetext = (
                   9129:                         official   => 'institutional',
                   9130:                         unofficial => 'non-institutional',
                   9131:                     );
1.799     bisitz   9132:                     $new_user_create = '<p class="LC_warning">'
                   9133:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9134:                                       .' '
                   9135:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9136:                                           ,'<a href="'.$helplink.'">','</a>')
                   9137:                                       .'</p><br />';
1.627     raeburn  9138:                 }
1.576     raeburn  9139:             }
                   9140:         }
                   9141: 
1.556     raeburn  9142:         $newuserscript = <<"ENDSCRIPT";
                   9143: 
1.570     raeburn  9144: function setSearch(createnew,callingForm) {
1.556     raeburn  9145:     if (createnew == 1) {
1.570     raeburn  9146:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9147:             if (callingForm.srchby.options[i].value == 'uname') {
                   9148:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9149:             }
                   9150:         }
1.570     raeburn  9151:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9152:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9153: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9154:             }
                   9155:         }
1.570     raeburn  9156:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9157:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9158:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9159:             }
                   9160:         }
1.570     raeburn  9161:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9162:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9163:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9164:             }
                   9165:         }
                   9166:     }
                   9167: }
                   9168: ENDSCRIPT
1.558     albertel 9169: 
1.556     raeburn  9170:     }
                   9171: 
1.555     raeburn  9172:     my $output = <<"END_BLOCK";
1.556     raeburn  9173: <script type="text/javascript">
1.824     bisitz   9174: // <![CDATA[
1.570     raeburn  9175: function validateEntry(callingForm) {
1.558     albertel 9176: 
1.556     raeburn  9177:     var checkok = 1;
1.558     albertel 9178:     var srchin;
1.570     raeburn  9179:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9180: 	if ( callingForm.srchin[i].checked ) {
                   9181: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9182: 	}
                   9183:     }
                   9184: 
1.570     raeburn  9185:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9186:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9187:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9188:     var srchterm =  callingForm.srchterm.value;
                   9189:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9190:     var msg = "";
                   9191: 
                   9192:     if (srchterm == "") {
                   9193:         checkok = 0;
1.571     raeburn  9194:         msg += "$lt{'youm'}\\n";
1.556     raeburn  9195:     }
                   9196: 
1.569     raeburn  9197:     if (srchtype== 'begins') {
                   9198:         if (srchterm.length < 2) {
                   9199:             checkok = 0;
1.571     raeburn  9200:             msg += "$lt{'thte'}\\n";
1.569     raeburn  9201:         }
                   9202:     }
                   9203: 
1.556     raeburn  9204:     if (srchtype== 'contains') {
                   9205:         if (srchterm.length < 3) {
                   9206:             checkok = 0;
1.571     raeburn  9207:             msg += "$lt{'thet'}\\n";
1.556     raeburn  9208:         }
                   9209:     }
                   9210:     if (srchin == 'instd') {
                   9211:         if (srchdomain == '') {
                   9212:             checkok = 0;
1.571     raeburn  9213:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  9214:         }
                   9215:     }
                   9216:     if (srchin == 'dom') {
                   9217:         if (srchdomain == '') {
                   9218:             checkok = 0;
1.571     raeburn  9219:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  9220:         }
                   9221:     }
                   9222:     if (srchby == 'lastfirst') {
                   9223:         if (srchterm.indexOf(",") == -1) {
                   9224:             checkok = 0;
1.571     raeburn  9225:             msg += "$lt{'whus'}\\n";
1.556     raeburn  9226:         }
                   9227:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9228:             checkok = 0;
1.571     raeburn  9229:             msg += "$lt{'whse'}\\n";
1.556     raeburn  9230:         }
                   9231:     }
                   9232:     if (checkok == 0) {
1.571     raeburn  9233:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  9234:         return;
                   9235:     }
                   9236:     if (checkok == 1) {
1.570     raeburn  9237:         callingForm.submit();
1.556     raeburn  9238:     }
                   9239: }
                   9240: 
                   9241: $newuserscript
                   9242: 
1.824     bisitz   9243: // ]]>
1.556     raeburn  9244: </script>
1.558     albertel 9245: 
                   9246: $new_user_create
                   9247: 
1.555     raeburn  9248: END_BLOCK
1.558     albertel 9249: 
1.876     raeburn  9250:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   9251:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   9252:                $domform.
                   9253:                &Apache::lonhtmlcommon::row_closure().
                   9254:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   9255:                $srchbysel.
                   9256:                $srchtypesel. 
                   9257:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9258:                $srchinsel.
                   9259:                &Apache::lonhtmlcommon::row_closure(1). 
                   9260:                &Apache::lonhtmlcommon::end_pick_box().
                   9261:                '<br />';
1.555     raeburn  9262:     return $output;
                   9263: }
                   9264: 
1.612     raeburn  9265: sub user_rule_check {
1.615     raeburn  9266:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  9267:     my $response;
                   9268:     if (ref($usershash) eq 'HASH') {
                   9269:         foreach my $user (keys(%{$usershash})) {
                   9270:             my ($uname,$udom) = split(/:/,$user);
                   9271:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  9272:             my ($id,$newuser);
1.612     raeburn  9273:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  9274:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  9275:                 $id = $usershash->{$user}->{'id'};
                   9276:             }
                   9277:             my $inst_response;
                   9278:             if (ref($checks) eq 'HASH') {
                   9279:                 if (defined($checks->{'username'})) {
1.615     raeburn  9280:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  9281:                         &Apache::lonnet::get_instuser($udom,$uname);
                   9282:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  9283:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  9284:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   9285:                 }
1.615     raeburn  9286:             } else {
                   9287:                 ($inst_response,%{$inst_results->{$user}}) =
                   9288:                     &Apache::lonnet::get_instuser($udom,$uname);
                   9289:                 return;
1.612     raeburn  9290:             }
1.615     raeburn  9291:             if (!$got_rules->{$udom}) {
1.612     raeburn  9292:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9293:                                                   ['usercreation'],$udom);
                   9294:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  9295:                     foreach my $item ('username','id') {
1.612     raeburn  9296:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9297:                             $$curr_rules{$udom}{$item} = 
                   9298:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  9299:                         }
                   9300:                     }
                   9301:                 }
1.615     raeburn  9302:                 $got_rules->{$udom} = 1;  
1.585     raeburn  9303:             }
1.612     raeburn  9304:             foreach my $item (keys(%{$checks})) {
                   9305:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9306:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9307:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   9308:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   9309:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9310:                                 if ($rule_check{$rule}) {
                   9311:                                     $$rulematch{$user}{$item} = $rule;
                   9312:                                     if ($inst_response eq 'ok') {
1.615     raeburn  9313:                                         if (ref($inst_results) eq 'HASH') {
                   9314:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9315:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9316:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   9317:                                                 }
1.612     raeburn  9318:                                             }
                   9319:                                         }
1.615     raeburn  9320:                                     }
                   9321:                                     last;
1.585     raeburn  9322:                                 }
                   9323:                             }
                   9324:                         }
                   9325:                     }
                   9326:                 }
                   9327:             }
                   9328:         }
                   9329:     }
1.612     raeburn  9330:     return;
                   9331: }
                   9332: 
                   9333: sub user_rule_formats {
                   9334:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9335:     my %text = ( 
                   9336:                  'username' => 'Usernames',
                   9337:                  'id'       => 'IDs',
                   9338:                );
                   9339:     my $output;
                   9340:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9341:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9342:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  9343:             $output = '<br />'.
                   9344:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9345:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9346:                       ' <ul>';
1.612     raeburn  9347:             foreach my $rule (@{$ruleorder}) {
                   9348:                 if (ref($curr_rules) eq 'ARRAY') {
                   9349:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9350:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9351:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9352:                                         $rules->{$rule}{'desc'}.'</li>';
                   9353:                         }
                   9354:                     }
                   9355:                 }
                   9356:             }
                   9357:             $output .= '</ul>';
                   9358:         }
                   9359:     }
                   9360:     return $output;
                   9361: }
                   9362: 
                   9363: sub instrule_disallow_msg {
1.615     raeburn  9364:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9365:     my $response;
                   9366:     my %text = (
                   9367:                   item   => 'username',
                   9368:                   items  => 'usernames',
                   9369:                   match  => 'matches',
                   9370:                   do     => 'does',
                   9371:                   action => 'a username',
                   9372:                   one    => 'one',
                   9373:                );
                   9374:     if ($count > 1) {
                   9375:         $text{'item'} = 'usernames';
                   9376:         $text{'match'} ='match';
                   9377:         $text{'do'} = 'do';
                   9378:         $text{'action'} = 'usernames',
                   9379:         $text{'one'} = 'ones';
                   9380:     }
                   9381:     if ($checkitem eq 'id') {
                   9382:         $text{'items'} = 'IDs';
                   9383:         $text{'item'} = 'ID';
                   9384:         $text{'action'} = 'an ID';
1.615     raeburn  9385:         if ($count > 1) {
                   9386:             $text{'item'} = 'IDs';
                   9387:             $text{'action'} = 'IDs';
                   9388:         }
1.612     raeburn  9389:     }
1.674     bisitz   9390:     $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  9391:     if ($mode eq 'upload') {
                   9392:         if ($checkitem eq 'username') {
                   9393:             $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'}.");
                   9394:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9395:             $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  9396:         }
1.669     raeburn  9397:     } elsif ($mode eq 'selfcreate') {
                   9398:         if ($checkitem eq 'id') {
                   9399:             $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.");
                   9400:         }
1.615     raeburn  9401:     } else {
                   9402:         if ($checkitem eq 'username') {
                   9403:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9404:         } elsif ($checkitem eq 'id') {
                   9405:             $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.");
                   9406:         }
1.612     raeburn  9407:     }
                   9408:     return $response;
1.585     raeburn  9409: }
                   9410: 
1.624     raeburn  9411: sub personal_data_fieldtitles {
                   9412:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9413:                         id => 'Student/Employee ID',
                   9414:                         permanentemail => 'E-mail address',
                   9415:                         lastname => 'Last Name',
                   9416:                         firstname => 'First Name',
                   9417:                         middlename => 'Middle Name',
                   9418:                         generation => 'Generation',
                   9419:                         gen => 'Generation',
1.765     raeburn  9420:                         inststatus => 'Affiliation',
1.624     raeburn  9421:                    );
                   9422:     return %fieldtitles;
                   9423: }
                   9424: 
1.642     raeburn  9425: sub sorted_inst_types {
                   9426:     my ($dom) = @_;
1.1075.2.70! raeburn  9427:     my ($usertypes,$order);
        !          9428:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
        !          9429:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
        !          9430:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
        !          9431:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
        !          9432:     } else {
        !          9433:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
        !          9434:     }
1.642     raeburn  9435:     my $othertitle = &mt('All users');
                   9436:     if ($env{'request.course.id'}) {
1.668     raeburn  9437:         $othertitle  = &mt('Any users');
1.642     raeburn  9438:     }
                   9439:     my @types;
                   9440:     if (ref($order) eq 'ARRAY') {
                   9441:         @types = @{$order};
                   9442:     }
                   9443:     if (@types == 0) {
                   9444:         if (ref($usertypes) eq 'HASH') {
                   9445:             @types = sort(keys(%{$usertypes}));
                   9446:         }
                   9447:     }
                   9448:     if (keys(%{$usertypes}) > 0) {
                   9449:         $othertitle = &mt('Other users');
                   9450:     }
                   9451:     return ($othertitle,$usertypes,\@types);
                   9452: }
                   9453: 
1.645     raeburn  9454: sub get_institutional_codes {
                   9455:     my ($settings,$allcourses,$LC_code) = @_;
                   9456: # Get complete list of course sections to update
                   9457:     my @currsections = ();
                   9458:     my @currxlists = ();
                   9459:     my $coursecode = $$settings{'internal.coursecode'};
                   9460: 
                   9461:     if ($$settings{'internal.sectionnums'} ne '') {
                   9462:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9463:     }
                   9464: 
                   9465:     if ($$settings{'internal.crosslistings'} ne '') {
                   9466:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9467:     }
                   9468: 
                   9469:     if (@currxlists > 0) {
                   9470:         foreach (@currxlists) {
                   9471:             if (m/^([^:]+):(\w*)$/) {
                   9472:                 unless (grep/^$1$/,@{$allcourses}) {
                   9473:                     push @{$allcourses},$1;
                   9474:                     $$LC_code{$1} = $2;
                   9475:                 }
                   9476:             }
                   9477:         }
                   9478:     }
                   9479:  
                   9480:     if (@currsections > 0) {
                   9481:         foreach (@currsections) {
                   9482:             if (m/^(\w+):(\w*)$/) {
                   9483:                 my $sec = $coursecode.$1;
                   9484:                 my $lc_sec = $2;
                   9485:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9486:                     push @{$allcourses},$sec;
                   9487:                     $$LC_code{$sec} = $lc_sec;
                   9488:                 }
                   9489:             }
                   9490:         }
                   9491:     }
                   9492:     return;
                   9493: }
                   9494: 
1.971     raeburn  9495: sub get_standard_codeitems {
                   9496:     return ('Year','Semester','Department','Number','Section');
                   9497: }
                   9498: 
1.112     bowersj2 9499: =pod
                   9500: 
1.780     raeburn  9501: =head1 Slot Helpers
                   9502: 
                   9503: =over 4
                   9504: 
                   9505: =item * sorted_slots()
                   9506: 
1.1040    raeburn  9507: Sorts an array of slot names in order of an optional sort key,
                   9508: default sort is by slot start time (earliest first). 
1.780     raeburn  9509: 
                   9510: Inputs:
                   9511: 
                   9512: =over 4
                   9513: 
                   9514: slotsarr  - Reference to array of unsorted slot names.
                   9515: 
                   9516: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9517: 
1.1040    raeburn  9518: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9519: 
1.549     albertel 9520: =back
                   9521: 
1.780     raeburn  9522: Returns:
                   9523: 
                   9524: =over 4
                   9525: 
1.1040    raeburn  9526: sorted   - An array of slot names sorted by a specified sort key 
                   9527:            (default sort key is start time of the slot).
1.780     raeburn  9528: 
                   9529: =back
                   9530: 
                   9531: =cut
                   9532: 
                   9533: 
                   9534: sub sorted_slots {
1.1040    raeburn  9535:     my ($slotsarr,$slots,$sortkey) = @_;
                   9536:     if ($sortkey eq '') {
                   9537:         $sortkey = 'starttime';
                   9538:     }
1.780     raeburn  9539:     my @sorted;
                   9540:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9541:         @sorted =
                   9542:             sort {
                   9543:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9544:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9545:                      }
                   9546:                      if (ref($slots->{$a})) { return -1;}
                   9547:                      if (ref($slots->{$b})) { return 1;}
                   9548:                      return 0;
                   9549:                  } @{$slotsarr};
                   9550:     }
                   9551:     return @sorted;
                   9552: }
                   9553: 
1.1040    raeburn  9554: =pod
                   9555: 
                   9556: =item * get_future_slots()
                   9557: 
                   9558: Inputs:
                   9559: 
                   9560: =over 4
                   9561: 
                   9562: cnum - course number
                   9563: 
                   9564: cdom - course domain
                   9565: 
                   9566: now - current UNIX time
                   9567: 
                   9568: symb - optional symb
                   9569: 
                   9570: =back
                   9571: 
                   9572: Returns:
                   9573: 
                   9574: =over 4
                   9575: 
                   9576: sorted_reservable - ref to array of student_schedulable slots currently 
                   9577:                     reservable, ordered by end date of reservation period.
                   9578: 
                   9579: reservable_now - ref to hash of student_schedulable slots currently
                   9580:                  reservable.
                   9581: 
                   9582:     Keys in inner hash are:
                   9583:     (a) symb: either blank or symb to which slot use is restricted.
                   9584:     (b) endreserve: end date of reservation period. 
                   9585: 
                   9586: sorted_future - ref to array of student_schedulable slots reservable in
                   9587:                 the future, ordered by start date of reservation period.
                   9588: 
                   9589: future_reservable - ref to hash of student_schedulable slots reservable
                   9590:                     in the future.
                   9591: 
                   9592:     Keys in inner hash are:
                   9593:     (a) symb: either blank or symb to which slot use is restricted.
                   9594:     (b) startreserve:  start date of reservation period.
                   9595: 
                   9596: =back
                   9597: 
                   9598: =cut
                   9599: 
                   9600: sub get_future_slots {
                   9601:     my ($cnum,$cdom,$now,$symb) = @_;
                   9602:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9603:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9604:     foreach my $slot (keys(%slots)) {
                   9605:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9606:         if ($symb) {
                   9607:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9608:                      ($slots{$slot}->{'symb'} ne $symb));
                   9609:         }
                   9610:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9611:             ($slots{$slot}->{'endtime'} > $now)) {
                   9612:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9613:                 my $userallowed = 0;
                   9614:                 if ($slots{$slot}->{'allowedsections'}) {
                   9615:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9616:                     if (!defined($env{'request.role.sec'})
                   9617:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9618:                         $userallowed=1;
                   9619:                     } else {
                   9620:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9621:                             $userallowed=1;
                   9622:                         }
                   9623:                     }
                   9624:                     unless ($userallowed) {
                   9625:                         if (defined($env{'request.course.groups'})) {
                   9626:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9627:                             foreach my $group (@groups) {
                   9628:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9629:                                     $userallowed=1;
                   9630:                                     last;
                   9631:                                 }
                   9632:                             }
                   9633:                         }
                   9634:                     }
                   9635:                 }
                   9636:                 if ($slots{$slot}->{'allowedusers'}) {
                   9637:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9638:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9639:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9640:                         $userallowed = 1;
                   9641:                     }
                   9642:                 }
                   9643:                 next unless($userallowed);
                   9644:             }
                   9645:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9646:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9647:             my $symb = $slots{$slot}->{'symb'};
                   9648:             if (($startreserve < $now) &&
                   9649:                 (!$endreserve || $endreserve > $now)) {
                   9650:                 my $lastres = $endreserve;
                   9651:                 if (!$lastres) {
                   9652:                     $lastres = $slots{$slot}->{'starttime'};
                   9653:                 }
                   9654:                 $reservable_now{$slot} = {
                   9655:                                            symb       => $symb,
                   9656:                                            endreserve => $lastres
                   9657:                                          };
                   9658:             } elsif (($startreserve > $now) &&
                   9659:                      (!$endreserve || $endreserve > $startreserve)) {
                   9660:                 $future_reservable{$slot} = {
                   9661:                                               symb         => $symb,
                   9662:                                               startreserve => $startreserve
                   9663:                                             };
                   9664:             }
                   9665:         }
                   9666:     }
                   9667:     my @unsorted_reservable = keys(%reservable_now);
                   9668:     if (@unsorted_reservable > 0) {
                   9669:         @sorted_reservable = 
                   9670:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9671:     }
                   9672:     my @unsorted_future = keys(%future_reservable);
                   9673:     if (@unsorted_future > 0) {
                   9674:         @sorted_future =
                   9675:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9676:     }
                   9677:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9678: }
1.780     raeburn  9679: 
                   9680: =pod
                   9681: 
1.1057    foxr     9682: =back
                   9683: 
1.549     albertel 9684: =head1 HTTP Helpers
                   9685: 
                   9686: =over 4
                   9687: 
1.648     raeburn  9688: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9689: 
1.258     albertel 9690: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9691: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9692: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9693: 
                   9694: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9695: $possible_names is an ref to an array of form element names.  As an example:
                   9696: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9697: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9698: 
                   9699: =cut
1.1       albertel 9700: 
1.6       albertel 9701: sub get_unprocessed_cgi {
1.25      albertel 9702:   my ($query,$possible_names)= @_;
1.26      matthew  9703:   # $Apache::lonxml::debug=1;
1.356     albertel 9704:   foreach my $pair (split(/&/,$query)) {
                   9705:     my ($name, $value) = split(/=/,$pair);
1.369     www      9706:     $name = &unescape($name);
1.25      albertel 9707:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9708:       $value =~ tr/+/ /;
                   9709:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9710:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9711:     }
1.16      harris41 9712:   }
1.6       albertel 9713: }
                   9714: 
1.112     bowersj2 9715: =pod
                   9716: 
1.648     raeburn  9717: =item * &cacheheader() 
1.112     bowersj2 9718: 
                   9719: returns cache-controlling header code
                   9720: 
                   9721: =cut
                   9722: 
1.7       albertel 9723: sub cacheheader {
1.258     albertel 9724:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9725:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9726:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9727:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9728:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9729:     return $output;
1.7       albertel 9730: }
                   9731: 
1.112     bowersj2 9732: =pod
                   9733: 
1.648     raeburn  9734: =item * &no_cache($r) 
1.112     bowersj2 9735: 
                   9736: specifies header code to not have cache
                   9737: 
                   9738: =cut
                   9739: 
1.9       albertel 9740: sub no_cache {
1.216     albertel 9741:     my ($r) = @_;
                   9742:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9743: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9744:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9745:     $r->no_cache(1);
                   9746:     $r->header_out("Expires" => $date);
                   9747:     $r->header_out("Pragma" => "no-cache");
1.123     www      9748: }
                   9749: 
                   9750: sub content_type {
1.181     albertel 9751:     my ($r,$type,$charset) = @_;
1.299     foxr     9752:     if ($r) {
                   9753: 	#  Note that printout.pl calls this with undef for $r.
                   9754: 	&no_cache($r);
                   9755:     }
1.258     albertel 9756:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9757:     unless ($charset) {
                   9758: 	$charset=&Apache::lonlocal::current_encoding;
                   9759:     }
                   9760:     if ($charset) { $type.='; charset='.$charset; }
                   9761:     if ($r) {
                   9762: 	$r->content_type($type);
                   9763:     } else {
                   9764: 	print("Content-type: $type\n\n");
                   9765:     }
1.9       albertel 9766: }
1.25      albertel 9767: 
1.112     bowersj2 9768: =pod
                   9769: 
1.648     raeburn  9770: =item * &add_to_env($name,$value) 
1.112     bowersj2 9771: 
1.258     albertel 9772: adds $name to the %env hash with value
1.112     bowersj2 9773: $value, if $name already exists, the entry is converted to an array
                   9774: reference and $value is added to the array.
                   9775: 
                   9776: =cut
                   9777: 
1.25      albertel 9778: sub add_to_env {
                   9779:   my ($name,$value)=@_;
1.258     albertel 9780:   if (defined($env{$name})) {
                   9781:     if (ref($env{$name})) {
1.25      albertel 9782:       #already have multiple values
1.258     albertel 9783:       push(@{ $env{$name} },$value);
1.25      albertel 9784:     } else {
                   9785:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9786:       my $first=$env{$name};
                   9787:       undef($env{$name});
                   9788:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9789:     }
                   9790:   } else {
1.258     albertel 9791:     $env{$name}=$value;
1.25      albertel 9792:   }
1.31      albertel 9793: }
1.149     albertel 9794: 
                   9795: =pod
                   9796: 
1.648     raeburn  9797: =item * &get_env_multiple($name) 
1.149     albertel 9798: 
1.258     albertel 9799: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9800: values may be defined and end up as an array ref.
                   9801: 
                   9802: returns an array of values
                   9803: 
                   9804: =cut
                   9805: 
                   9806: sub get_env_multiple {
                   9807:     my ($name) = @_;
                   9808:     my @values;
1.258     albertel 9809:     if (defined($env{$name})) {
1.149     albertel 9810:         # exists is it an array
1.258     albertel 9811:         if (ref($env{$name})) {
                   9812:             @values=@{ $env{$name} };
1.149     albertel 9813:         } else {
1.258     albertel 9814:             $values[0]=$env{$name};
1.149     albertel 9815:         }
                   9816:     }
                   9817:     return(@values);
                   9818: }
                   9819: 
1.660     raeburn  9820: sub ask_for_embedded_content {
                   9821:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9822:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  9823:         %currsubfile,%unused,$rem);
1.1071    raeburn  9824:     my $counter = 0;
                   9825:     my $numnew = 0;
1.987     raeburn  9826:     my $numremref = 0;
                   9827:     my $numinvalid = 0;
                   9828:     my $numpathchg = 0;
                   9829:     my $numexisting = 0;
1.1071    raeburn  9830:     my $numunused = 0;
                   9831:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53  raeburn  9832:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  9833:     my $heading = &mt('Upload embedded files');
                   9834:     my $buttontext = &mt('Upload');
                   9835: 
1.1075.2.11  raeburn  9836:     if ($env{'request.course.id'}) {
1.1075.2.35  raeburn  9837:         if ($actionurl eq '/adm/dependencies') {
                   9838:             $navmap = Apache::lonnavmaps::navmap->new();
                   9839:         }
                   9840:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9841:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11  raeburn  9842:     }
1.1075.2.35  raeburn  9843:     if (($actionurl eq '/adm/portfolio') ||
                   9844:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  9845:         my $current_path='/';
                   9846:         if ($env{'form.currentpath'}) {
                   9847:             $current_path = $env{'form.currentpath'};
                   9848:         }
                   9849:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35  raeburn  9850:             $udom = $cdom;
                   9851:             $uname = $cnum;
1.984     raeburn  9852:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9853:         } else {
                   9854:             $udom = $env{'user.domain'};
                   9855:             $uname = $env{'user.name'};
                   9856:             $url = '/userfiles/portfolio';
                   9857:         }
1.987     raeburn  9858:         $toplevel = $url.'/';
1.984     raeburn  9859:         $url .= $current_path;
                   9860:         $getpropath = 1;
1.987     raeburn  9861:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9862:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9863:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9864:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9865:         $toplevel = $url;
1.984     raeburn  9866:         if ($rest ne '') {
1.987     raeburn  9867:             $url .= $rest;
                   9868:         }
                   9869:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9870:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9871:             $url = $args->{'docs_url'};
                   9872:             $toplevel = $url;
1.1075.2.11  raeburn  9873:             if ($args->{'context'} eq 'paste') {
                   9874:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9875:                 ($path) =
                   9876:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9877:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9878:                 $fileloc =~ s{^/}{};
                   9879:             }
1.1071    raeburn  9880:         }
                   9881:     } elsif ($actionurl eq '/adm/dependencies') {
                   9882:         if ($env{'request.course.id'} ne '') {
                   9883:             if (ref($args) eq 'HASH') {
                   9884:                 $url = $args->{'docs_url'};
                   9885:                 $title = $args->{'docs_title'};
1.1075.2.35  raeburn  9886:                 $toplevel = $url;
                   9887:                 unless ($toplevel =~ m{^/}) {
                   9888:                     $toplevel = "/$url";
                   9889:                 }
1.1075.2.11  raeburn  9890:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35  raeburn  9891:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   9892:                     $path = $1;
                   9893:                 } else {
                   9894:                     ($path) =
                   9895:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9896:                 }
1.1071    raeburn  9897:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9898:                 $fileloc =~ s{^/}{};
                   9899:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9900:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9901:             }
1.987     raeburn  9902:         }
1.1075.2.35  raeburn  9903:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9904:         $udom = $cdom;
                   9905:         $uname = $cnum;
                   9906:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   9907:         $toplevel = $url;
                   9908:         $path = $url;
                   9909:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   9910:         $fileloc =~ s{^/}{};
                   9911:     }
                   9912:     foreach my $file (keys(%{$allfiles})) {
                   9913:         my $embed_file;
                   9914:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   9915:             $embed_file = $1;
                   9916:         } else {
                   9917:             $embed_file = $file;
                   9918:         }
1.1075.2.55  raeburn  9919:         my ($absolutepath,$cleaned_file);
                   9920:         if ($embed_file =~ m{^\w+://}) {
                   9921:             $cleaned_file = $embed_file;
1.1075.2.47  raeburn  9922:             $newfiles{$cleaned_file} = 1;
                   9923:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9924:         } else {
1.1075.2.55  raeburn  9925:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  9926:             if ($embed_file =~ m{^/}) {
                   9927:                 $absolutepath = $embed_file;
                   9928:             }
1.1075.2.47  raeburn  9929:             if ($cleaned_file =~ m{/}) {
                   9930:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  9931:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9932:                 my $item = $fname;
                   9933:                 if ($path ne '') {
                   9934:                     $item = $path.'/'.$fname;
                   9935:                     $subdependencies{$path}{$fname} = 1;
                   9936:                 } else {
                   9937:                     $dependencies{$item} = 1;
                   9938:                 }
                   9939:                 if ($absolutepath) {
                   9940:                     $mapping{$item} = $absolutepath;
                   9941:                 } else {
                   9942:                     $mapping{$item} = $embed_file;
                   9943:                 }
                   9944:             } else {
                   9945:                 $dependencies{$embed_file} = 1;
                   9946:                 if ($absolutepath) {
1.1075.2.47  raeburn  9947:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  9948:                 } else {
1.1075.2.47  raeburn  9949:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9950:                 }
                   9951:             }
1.984     raeburn  9952:         }
                   9953:     }
1.1071    raeburn  9954:     my $dirptr = 16384;
1.984     raeburn  9955:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9956:         $currsubfile{$path} = {};
1.1075.2.35  raeburn  9957:         if (($actionurl eq '/adm/portfolio') ||
                   9958:             ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  9959:             my ($sublistref,$listerror) =
                   9960:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9961:             if (ref($sublistref) eq 'ARRAY') {
                   9962:                 foreach my $line (@{$sublistref}) {
                   9963:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9964:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9965:                 }
1.984     raeburn  9966:             }
1.987     raeburn  9967:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9968:             if (opendir(my $dir,$url.'/'.$path)) {
                   9969:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9970:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9971:             }
1.1075.2.11  raeburn  9972:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9973:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  9974:                   ($args->{'context'} eq 'paste')) ||
                   9975:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  9976:             if ($env{'request.course.id'} ne '') {
1.1075.2.35  raeburn  9977:                 my $dir;
                   9978:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9979:                     $dir = $fileloc;
                   9980:                 } else {
                   9981:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9982:                 }
1.1071    raeburn  9983:                 if ($dir ne '') {
                   9984:                     my ($sublistref,$listerror) =
                   9985:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9986:                     if (ref($sublistref) eq 'ARRAY') {
                   9987:                         foreach my $line (@{$sublistref}) {
                   9988:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9989:                                 undef,$mtime)=split(/\&/,$line,12);
                   9990:                             unless (($testdir&$dirptr) ||
                   9991:                                     ($file_name =~ /^\.\.?$/)) {
                   9992:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9993:                             }
                   9994:                         }
                   9995:                     }
                   9996:                 }
1.984     raeburn  9997:             }
                   9998:         }
                   9999:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  10000:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  10001:                 my $item = $path.'/'.$file;
                   10002:                 unless ($mapping{$item} eq $item) {
                   10003:                     $pathchanges{$item} = 1;
                   10004:                 }
                   10005:                 $existing{$item} = 1;
                   10006:                 $numexisting ++;
                   10007:             } else {
                   10008:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10009:             }
                   10010:         }
1.1071    raeburn  10011:         if ($actionurl eq '/adm/dependencies') {
                   10012:             foreach my $path (keys(%currsubfile)) {
                   10013:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10014:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10015:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  10016:                              next if (($rem ne '') &&
                   10017:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10018:                                        (ref($navmap) &&
                   10019:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10020:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10021:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10022:                              $unused{$path.'/'.$file} = 1; 
                   10023:                          }
                   10024:                     }
                   10025:                 }
                   10026:             }
                   10027:         }
1.984     raeburn  10028:     }
1.987     raeburn  10029:     my %currfile;
1.1075.2.35  raeburn  10030:     if (($actionurl eq '/adm/portfolio') ||
                   10031:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10032:         my ($dirlistref,$listerror) =
                   10033:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10034:         if (ref($dirlistref) eq 'ARRAY') {
                   10035:             foreach my $line (@{$dirlistref}) {
                   10036:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10037:                 $currfile{$file_name} = 1;
                   10038:             }
1.984     raeburn  10039:         }
1.987     raeburn  10040:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10041:         if (opendir(my $dir,$url)) {
1.987     raeburn  10042:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10043:             map {$currfile{$_} = 1;} @dir_list;
                   10044:         }
1.1075.2.11  raeburn  10045:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10046:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  10047:               ($args->{'context'} eq 'paste')) ||
                   10048:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10049:         if ($env{'request.course.id'} ne '') {
                   10050:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10051:             if ($dir ne '') {
                   10052:                 my ($dirlistref,$listerror) =
                   10053:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10054:                 if (ref($dirlistref) eq 'ARRAY') {
                   10055:                     foreach my $line (@{$dirlistref}) {
                   10056:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10057:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10058:                         unless (($testdir&$dirptr) ||
                   10059:                                 ($file_name =~ /^\.\.?$/)) {
                   10060:                             $currfile{$file_name} = [$size,$mtime];
                   10061:                         }
                   10062:                     }
                   10063:                 }
                   10064:             }
                   10065:         }
1.984     raeburn  10066:     }
                   10067:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10068:         if (exists($currfile{$file})) {
1.987     raeburn  10069:             unless ($mapping{$file} eq $file) {
                   10070:                 $pathchanges{$file} = 1;
                   10071:             }
                   10072:             $existing{$file} = 1;
                   10073:             $numexisting ++;
                   10074:         } else {
1.984     raeburn  10075:             $newfiles{$file} = 1;
                   10076:         }
                   10077:     }
1.1071    raeburn  10078:     foreach my $file (keys(%currfile)) {
                   10079:         unless (($file eq $filename) ||
                   10080:                 ($file eq $filename.'.bak') ||
                   10081:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  10082:             if ($actionurl eq '/adm/dependencies') {
1.1075.2.35  raeburn  10083:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10084:                     next if (($rem ne '') &&
                   10085:                              (($env{"httpref.$rem".$file} ne '') ||
                   10086:                               (ref($navmap) &&
                   10087:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10088:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10089:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10090:                 }
1.1075.2.11  raeburn  10091:             }
1.1071    raeburn  10092:             $unused{$file} = 1;
                   10093:         }
                   10094:     }
1.1075.2.11  raeburn  10095:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10096:         ($args->{'context'} eq 'paste')) {
                   10097:         $counter = scalar(keys(%existing));
                   10098:         $numpathchg = scalar(keys(%pathchanges));
                   10099:         return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35  raeburn  10100:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
                   10101:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10102:         $counter = scalar(keys(%existing));
                   10103:         $numpathchg = scalar(keys(%pathchanges));
                   10104:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11  raeburn  10105:     }
1.984     raeburn  10106:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10107:         if ($actionurl eq '/adm/dependencies') {
                   10108:             next if ($embed_file =~ m{^\w+://});
                   10109:         }
1.660     raeburn  10110:         $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10111:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10112:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10113:         unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35  raeburn  10114:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10115:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10116:         }
1.1075.2.35  raeburn  10117:         $upload_output .= '</td>';
1.1071    raeburn  10118:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1075.2.35  raeburn  10119:             $upload_output.='<td align="right">'.
                   10120:                             '<span class="LC_info LC_fontsize_medium">'.
                   10121:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10122:             $numremref++;
1.660     raeburn  10123:         } elsif ($args->{'error_on_invalid_names'}
                   10124:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35  raeburn  10125:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10126:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10127:             $numinvalid++;
1.660     raeburn  10128:         } else {
1.1075.2.35  raeburn  10129:             $upload_output .= '<td>'.
                   10130:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10131:                                                      $embed_file,\%mapping,
1.1071    raeburn  10132:                                                      $allfiles,$codebase,'upload');
                   10133:             $counter ++;
                   10134:             $numnew ++;
1.987     raeburn  10135:         }
                   10136:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10137:     }
                   10138:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10139:         if ($actionurl eq '/adm/dependencies') {
                   10140:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10141:             $modify_output .= &start_data_table_row().
                   10142:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10143:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10144:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10145:                               '<td>'.$size.'</td>'.
                   10146:                               '<td>'.$mtime.'</td>'.
                   10147:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10148:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10149:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10150:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10151:                               &embedded_file_element('upload_embedded',$counter,
                   10152:                                                      $embed_file,\%mapping,
                   10153:                                                      $allfiles,$codebase,'modify').
                   10154:                               '</div></td>'.
                   10155:                               &end_data_table_row()."\n";
                   10156:             $counter ++;
                   10157:         } else {
                   10158:             $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10159:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10160:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10161:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10162:                               &Apache::loncommon::end_data_table_row()."\n";
                   10163:         }
                   10164:     }
                   10165:     my $delidx = $counter;
                   10166:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10167:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10168:         $delete_output .= &start_data_table_row().
                   10169:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10170:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10171:                           '<td>'.$size.'</td>'.
                   10172:                           '<td>'.$mtime.'</td>'.
                   10173:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10174:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10175:                           &embedded_file_element('upload_embedded',$delidx,
                   10176:                                                  $oldfile,\%mapping,$allfiles,
                   10177:                                                  $codebase,'delete').'</td>'.
                   10178:                           &end_data_table_row()."\n"; 
                   10179:         $numunused ++;
                   10180:         $delidx ++;
1.987     raeburn  10181:     }
                   10182:     if ($upload_output) {
                   10183:         $upload_output = &start_data_table().
                   10184:                          $upload_output.
                   10185:                          &end_data_table()."\n";
                   10186:     }
1.1071    raeburn  10187:     if ($modify_output) {
                   10188:         $modify_output = &start_data_table().
                   10189:                          &start_data_table_header_row().
                   10190:                          '<th>'.&mt('File').'</th>'.
                   10191:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10192:                          '<th>'.&mt('Modified').'</th>'.
                   10193:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10194:                          &end_data_table_header_row().
                   10195:                          $modify_output.
                   10196:                          &end_data_table()."\n";
                   10197:     }
                   10198:     if ($delete_output) {
                   10199:         $delete_output = &start_data_table().
                   10200:                          &start_data_table_header_row().
                   10201:                          '<th>'.&mt('File').'</th>'.
                   10202:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10203:                          '<th>'.&mt('Modified').'</th>'.
                   10204:                          '<th>'.&mt('Delete?').'</th>'.
                   10205:                          &end_data_table_header_row().
                   10206:                          $delete_output.
                   10207:                          &end_data_table()."\n";
                   10208:     }
1.987     raeburn  10209:     my $applies = 0;
                   10210:     if ($numremref) {
                   10211:         $applies ++;
                   10212:     }
                   10213:     if ($numinvalid) {
                   10214:         $applies ++;
                   10215:     }
                   10216:     if ($numexisting) {
                   10217:         $applies ++;
                   10218:     }
1.1071    raeburn  10219:     if ($counter || $numunused) {
1.987     raeburn  10220:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10221:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10222:                   $state.'<h3>'.$heading.'</h3>'; 
                   10223:         if ($actionurl eq '/adm/dependencies') {
                   10224:             if ($numnew) {
                   10225:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10226:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10227:                            $upload_output.'<br />'."\n";
                   10228:             }
                   10229:             if ($numexisting) {
                   10230:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10231:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10232:                            $modify_output.'<br />'."\n";
                   10233:                            $buttontext = &mt('Save changes');
                   10234:             }
                   10235:             if ($numunused) {
                   10236:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10237:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10238:                            $delete_output.'<br />'."\n";
                   10239:                            $buttontext = &mt('Save changes');
                   10240:             }
                   10241:         } else {
                   10242:             $output .= $upload_output.'<br />'."\n";
                   10243:         }
                   10244:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10245:                    $counter.'" />'."\n";
                   10246:         if ($actionurl eq '/adm/dependencies') { 
                   10247:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10248:                        $numnew.'" />'."\n";
                   10249:         } elsif ($actionurl eq '') {
1.987     raeburn  10250:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10251:         }
                   10252:     } elsif ($applies) {
                   10253:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10254:         if ($applies > 1) {
                   10255:             $output .=  
1.1075.2.35  raeburn  10256:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10257:             if ($numremref) {
                   10258:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10259:             }
                   10260:             if ($numinvalid) {
                   10261:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10262:             }
                   10263:             if ($numexisting) {
                   10264:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10265:             }
                   10266:             $output .= '</ul><br />';
                   10267:         } elsif ($numremref) {
                   10268:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10269:         } elsif ($numinvalid) {
                   10270:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10271:         } elsif ($numexisting) {
                   10272:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10273:         }
                   10274:         $output .= $upload_output.'<br />';
                   10275:     }
                   10276:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10277:     $chgcount = $counter;
1.987     raeburn  10278:     if (keys(%pathchanges) > 0) {
                   10279:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10280:             if ($counter) {
1.987     raeburn  10281:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10282:                                                   $embed_file,\%mapping,
1.1071    raeburn  10283:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10284:             } else {
                   10285:                 $pathchange_output .= 
                   10286:                     &start_data_table_row().
                   10287:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10288:                     $chgcount.'" checked="checked" /></td>'.
                   10289:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10290:                     '<td>'.$embed_file.
                   10291:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10292:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10293:                     '</td>'.&end_data_table_row();
1.660     raeburn  10294:             }
1.987     raeburn  10295:             $numpathchg ++;
                   10296:             $chgcount ++;
1.660     raeburn  10297:         }
                   10298:     }
1.1075.2.35  raeburn  10299:     if (($counter) || ($numunused)) {
1.987     raeburn  10300:         if ($numpathchg) {
                   10301:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10302:                        $numpathchg.'" />'."\n";
                   10303:         }
                   10304:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10305:             ($actionurl eq '/adm/imsimport')) {
                   10306:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10307:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10308:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10309:         } elsif ($actionurl eq '/adm/dependencies') {
                   10310:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10311:         }
1.1075.2.35  raeburn  10312:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10313:     } elsif ($numpathchg) {
                   10314:         my %pathchange = ();
                   10315:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10316:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10317:             $output .= '<p>'.&mt('or').'</p>'; 
1.1075.2.35  raeburn  10318:         }
1.987     raeburn  10319:     }
1.1071    raeburn  10320:     return ($output,$counter,$numpathchg);
1.987     raeburn  10321: }
                   10322: 
1.1075.2.47  raeburn  10323: =pod
                   10324: 
                   10325: =item * clean_path($name)
                   10326: 
                   10327: Performs clean-up of directories, subdirectories and filename in an
                   10328: embedded object, referenced in an HTML file which is being uploaded
                   10329: to a course or portfolio, where
                   10330: "Upload embedded images/multimedia files if HTML file" checkbox was
                   10331: checked.
                   10332: 
                   10333: Clean-up is similar to replacements in lonnet::clean_filename()
                   10334: except each / between sub-directory and next level is preserved.
                   10335: 
                   10336: =cut
                   10337: 
                   10338: sub clean_path {
                   10339:     my ($embed_file) = @_;
                   10340:     $embed_file =~s{^/+}{};
                   10341:     my @contents;
                   10342:     if ($embed_file =~ m{/}) {
                   10343:         @contents = split(/\//,$embed_file);
                   10344:     } else {
                   10345:         @contents = ($embed_file);
                   10346:     }
                   10347:     my $lastidx = scalar(@contents)-1;
                   10348:     for (my $i=0; $i<=$lastidx; $i++) {
                   10349:         $contents[$i]=~s{\\}{/}g;
                   10350:         $contents[$i]=~s/\s+/\_/g;
                   10351:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   10352:         if ($i == $lastidx) {
                   10353:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   10354:         }
                   10355:     }
                   10356:     if ($lastidx > 0) {
                   10357:         return join('/',@contents);
                   10358:     } else {
                   10359:         return $contents[0];
                   10360:     }
                   10361: }
                   10362: 
1.987     raeburn  10363: sub embedded_file_element {
1.1071    raeburn  10364:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10365:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10366:                    (ref($codebase) eq 'HASH'));
                   10367:     my $output;
1.1071    raeburn  10368:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10369:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10370:     }
                   10371:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10372:                &escape($embed_file).'" />';
                   10373:     unless (($context eq 'upload_embedded') && 
                   10374:             ($mapping->{$embed_file} eq $embed_file)) {
                   10375:         $output .='
                   10376:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10377:     }
                   10378:     my $attrib;
                   10379:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10380:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10381:     }
                   10382:     $output .=
                   10383:         "\n\t\t".
                   10384:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10385:         $attrib.'" />';
                   10386:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10387:         $output .=
                   10388:             "\n\t\t".
                   10389:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10390:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10391:     }
1.987     raeburn  10392:     return $output;
1.660     raeburn  10393: }
                   10394: 
1.1071    raeburn  10395: sub get_dependency_details {
                   10396:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10397:     my ($size,$mtime,$showsize,$showmtime);
                   10398:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10399:         if ($embed_file =~ m{/}) {
                   10400:             my ($path,$fname) = split(/\//,$embed_file);
                   10401:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10402:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10403:             }
                   10404:         } else {
                   10405:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10406:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10407:             }
                   10408:         }
                   10409:         $showsize = $size/1024.0;
                   10410:         $showsize = sprintf("%.1f",$showsize);
                   10411:         if ($mtime > 0) {
                   10412:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10413:         }
                   10414:     }
                   10415:     return ($showsize,$showmtime);
                   10416: }
                   10417: 
                   10418: sub ask_embedded_js {
                   10419:     return <<"END";
                   10420: <script type="text/javascript"">
                   10421: // <![CDATA[
                   10422: function toggleBrowse(counter) {
                   10423:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10424:     var fileid = document.getElementById('embedded_item_'+counter);
                   10425:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10426:     if (chkboxid.checked == true) {
                   10427:         uploaddivid.style.display='block';
                   10428:     } else {
                   10429:         uploaddivid.style.display='none';
                   10430:         fileid.value = '';
                   10431:     }
                   10432: }
                   10433: // ]]>
                   10434: </script>
                   10435: 
                   10436: END
                   10437: }
                   10438: 
1.661     raeburn  10439: sub upload_embedded {
                   10440:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10441:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10442:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10443:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10444:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10445:         my $orig_uploaded_filename =
                   10446:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10447:         foreach my $type ('orig','ref','attrib','codebase') {
                   10448:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10449:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10450:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10451:             }
                   10452:         }
1.661     raeburn  10453:         my ($path,$fname) =
                   10454:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10455:         # no path, whole string is fname
                   10456:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10457:         $fname = &Apache::lonnet::clean_filename($fname);
                   10458:         # See if there is anything left
                   10459:         next if ($fname eq '');
                   10460: 
                   10461:         # Check if file already exists as a file or directory.
                   10462:         my ($state,$msg);
                   10463:         if ($context eq 'portfolio') {
                   10464:             my $port_path = $dirpath;
                   10465:             if ($group ne '') {
                   10466:                 $port_path = "groups/$group/$port_path";
                   10467:             }
1.987     raeburn  10468:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10469:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10470:                                               $dir_root,$port_path,$disk_quota,
                   10471:                                               $current_disk_usage,$uname,$udom);
                   10472:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10473:                 || $state eq 'file_locked') {
1.661     raeburn  10474:                 $output .= $msg;
                   10475:                 next;
                   10476:             }
                   10477:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10478:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10479:             if ($state eq 'exists') {
                   10480:                 $output .= $msg;
                   10481:                 next;
                   10482:             }
                   10483:         }
                   10484:         # Check if extension is valid
                   10485:         if (($fname =~ /\.(\w+)$/) &&
                   10486:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53  raeburn  10487:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   10488:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  10489:             next;
                   10490:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10491:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10492:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10493:             next;
                   10494:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34  raeburn  10495:             $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  10496:             next;
                   10497:         }
                   10498:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35  raeburn  10499:         my $subdir = $path;
                   10500:         $subdir =~ s{/+$}{};
1.661     raeburn  10501:         if ($context eq 'portfolio') {
1.984     raeburn  10502:             my $result;
                   10503:             if ($state eq 'existingfile') {
                   10504:                 $result=
                   10505:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35  raeburn  10506:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  10507:             } else {
1.984     raeburn  10508:                 $result=
                   10509:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10510:                                                     $dirpath.
1.1075.2.35  raeburn  10511:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  10512:                 if ($result !~ m|^/uploaded/|) {
                   10513:                     $output .= '<span class="LC_error">'
                   10514:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10515:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10516:                                .'</span><br />';
                   10517:                     next;
                   10518:                 } else {
1.987     raeburn  10519:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10520:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10521:                 }
1.661     raeburn  10522:             }
1.1075.2.35  raeburn  10523:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
                   10524:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   10525:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  10526:             my $result =
1.1075.2.35  raeburn  10527:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  10528:             if ($result !~ m|^/uploaded/|) {
                   10529:                 $output .= '<span class="LC_error">'
                   10530:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10531:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10532:                            .'</span><br />';
                   10533:                     next;
                   10534:             } else {
                   10535:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10536:                            $path.$fname.'</span>').'<br />';
1.1075.2.35  raeburn  10537:                 if ($context eq 'syllabus') {
                   10538:                     &Apache::lonnet::make_public_indefinitely($result);
                   10539:                 }
1.987     raeburn  10540:             }
1.661     raeburn  10541:         } else {
                   10542: # Save the file
                   10543:             my $target = $env{'form.embedded_item_'.$i};
                   10544:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10545:             my $dest = $fullpath.$fname;
                   10546:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10547:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10548:             my $count;
                   10549:             my $filepath = $dir_root;
1.1027    raeburn  10550:             foreach my $subdir (@parts) {
                   10551:                 $filepath .= "/$subdir";
                   10552:                 if (!-e $filepath) {
1.661     raeburn  10553:                     mkdir($filepath,0770);
                   10554:                 }
                   10555:             }
                   10556:             my $fh;
                   10557:             if (!open($fh,'>'.$dest)) {
                   10558:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10559:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10560:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10561:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10562:                            '</span><br />';
                   10563:             } else {
                   10564:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10565:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10566:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10567:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10568:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10569:                               '</span><br />';
                   10570:                 } else {
1.987     raeburn  10571:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10572:                                $url.'</span>').'<br />';
                   10573:                     unless ($context eq 'testbank') {
                   10574:                         $footer .= &mt('View embedded file: [_1]',
                   10575:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10576:                     }
                   10577:                 }
                   10578:                 close($fh);
                   10579:             }
                   10580:         }
                   10581:         if ($env{'form.embedded_ref_'.$i}) {
                   10582:             $pathchange{$i} = 1;
                   10583:         }
                   10584:     }
                   10585:     if ($output) {
                   10586:         $output = '<p>'.$output.'</p>';
                   10587:     }
                   10588:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10589:     $returnflag = 'ok';
1.1071    raeburn  10590:     my $numpathchgs = scalar(keys(%pathchange));
                   10591:     if ($numpathchgs > 0) {
1.987     raeburn  10592:         if ($context eq 'portfolio') {
                   10593:             $output .= '<p>'.&mt('or').'</p>';
                   10594:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10595:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10596:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10597:             $returnflag = 'modify_orightml';
                   10598:         }
                   10599:     }
1.1071    raeburn  10600:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10601: }
                   10602: 
                   10603: sub modify_html_form {
                   10604:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10605:     my $end = 0;
                   10606:     my $modifyform;
                   10607:     if ($context eq 'upload_embedded') {
                   10608:         return unless (ref($pathchange) eq 'HASH');
                   10609:         if ($env{'form.number_embedded_items'}) {
                   10610:             $end += $env{'form.number_embedded_items'};
                   10611:         }
                   10612:         if ($env{'form.number_pathchange_items'}) {
                   10613:             $end += $env{'form.number_pathchange_items'};
                   10614:         }
                   10615:         if ($end) {
                   10616:             for (my $i=0; $i<$end; $i++) {
                   10617:                 if ($i < $env{'form.number_embedded_items'}) {
                   10618:                     next unless($pathchange->{$i});
                   10619:                 }
                   10620:                 $modifyform .=
                   10621:                     &start_data_table_row().
                   10622:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10623:                     'checked="checked" /></td>'.
                   10624:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10625:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10626:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10627:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10628:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10629:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10630:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10631:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10632:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10633:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10634:                     &end_data_table_row();
1.1071    raeburn  10635:             }
1.987     raeburn  10636:         }
                   10637:     } else {
                   10638:         $modifyform = $pathchgtable;
                   10639:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10640:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10641:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10642:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10643:         }
                   10644:     }
                   10645:     if ($modifyform) {
1.1071    raeburn  10646:         if ($actionurl eq '/adm/dependencies') {
                   10647:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10648:         }
1.987     raeburn  10649:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10650:                '<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".
                   10651:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10652:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10653:                '</ol></p>'."\n".'<p>'.
                   10654:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10655:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10656:                &start_data_table()."\n".
                   10657:                &start_data_table_header_row().
                   10658:                '<th>'.&mt('Change?').'</th>'.
                   10659:                '<th>'.&mt('Current reference').'</th>'.
                   10660:                '<th>'.&mt('Required reference').'</th>'.
                   10661:                &end_data_table_header_row()."\n".
                   10662:                $modifyform.
                   10663:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10664:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10665:                '</form>'."\n";
                   10666:     }
                   10667:     return;
                   10668: }
                   10669: 
                   10670: sub modify_html_refs {
1.1075.2.35  raeburn  10671:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  10672:     my $container;
                   10673:     if ($context eq 'portfolio') {
                   10674:         $container = $env{'form.container'};
                   10675:     } elsif ($context eq 'coursedoc') {
                   10676:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10677:     } elsif ($context eq 'manage_dependencies') {
                   10678:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10679:         $container = "/$container";
1.1075.2.35  raeburn  10680:     } elsif ($context eq 'syllabus') {
                   10681:         $container = $url;
1.987     raeburn  10682:     } else {
1.1027    raeburn  10683:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10684:     }
                   10685:     my (%allfiles,%codebase,$output,$content);
                   10686:     my @changes = &get_env_multiple('form.namechange');
1.1075.2.35  raeburn  10687:     unless ((@changes > 0)  || ($context eq 'syllabus')) {
1.1071    raeburn  10688:         if (wantarray) {
                   10689:             return ('',0,0); 
                   10690:         } else {
                   10691:             return;
                   10692:         }
                   10693:     }
                   10694:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10695:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  10696:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10697:             if (wantarray) {
                   10698:                 return ('',0,0);
                   10699:             } else {
                   10700:                 return;
                   10701:             }
                   10702:         } 
1.987     raeburn  10703:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10704:         if ($content eq '-1') {
                   10705:             if (wantarray) {
                   10706:                 return ('',0,0);
                   10707:             } else {
                   10708:                 return;
                   10709:             }
                   10710:         }
1.987     raeburn  10711:     } else {
1.1071    raeburn  10712:         unless ($container =~ /^\Q$dir_root\E/) {
                   10713:             if (wantarray) {
                   10714:                 return ('',0,0);
                   10715:             } else {
                   10716:                 return;
                   10717:             }
                   10718:         } 
1.987     raeburn  10719:         if (open(my $fh,"<$container")) {
                   10720:             $content = join('', <$fh>);
                   10721:             close($fh);
                   10722:         } else {
1.1071    raeburn  10723:             if (wantarray) {
                   10724:                 return ('',0,0);
                   10725:             } else {
                   10726:                 return;
                   10727:             }
1.987     raeburn  10728:         }
                   10729:     }
                   10730:     my ($count,$codebasecount) = (0,0);
                   10731:     my $mm = new File::MMagic;
                   10732:     my $mime_type = $mm->checktype_contents($content);
                   10733:     if ($mime_type eq 'text/html') {
                   10734:         my $parse_result = 
                   10735:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10736:                                                     \%codebase,\$content);
                   10737:         if ($parse_result eq 'ok') {
                   10738:             foreach my $i (@changes) {
                   10739:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10740:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10741:                 if ($allfiles{$ref}) {
                   10742:                     my $newname =  $orig;
                   10743:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10744:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10745:                     if ($attrib_regexp =~ /:/) {
                   10746:                         $attrib_regexp =~ s/\:/|/g;
                   10747:                     }
                   10748:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10749:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10750:                         $count += $numchg;
1.1075.2.35  raeburn  10751:                         $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48  raeburn  10752:                         delete($allfiles{$ref});
1.987     raeburn  10753:                     }
                   10754:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10755:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10756:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10757:                         $codebasecount ++;
                   10758:                     }
                   10759:                 }
                   10760:             }
1.1075.2.35  raeburn  10761:             my $skiprewrites;
1.987     raeburn  10762:             if ($count || $codebasecount) {
                   10763:                 my $saveresult;
1.1071    raeburn  10764:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10765:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  10766:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10767:                     if ($url eq $container) {
                   10768:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10769:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10770:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10771:                                             $fname.'</span>').'</p>';
1.987     raeburn  10772:                     } else {
                   10773:                          $output = '<p class="LC_error">'.
                   10774:                                    &mt('Error: update failed for: [_1].',
                   10775:                                    '<span class="LC_filename">'.
                   10776:                                    $container.'</span>').'</p>';
                   10777:                     }
1.1075.2.35  raeburn  10778:                     if ($context eq 'syllabus') {
                   10779:                         unless ($saveresult eq 'ok') {
                   10780:                             $skiprewrites = 1;
                   10781:                         }
                   10782:                     }
1.987     raeburn  10783:                 } else {
                   10784:                     if (open(my $fh,">$container")) {
                   10785:                         print $fh $content;
                   10786:                         close($fh);
                   10787:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10788:                                   $count,'<span class="LC_filename">'.
                   10789:                                   $container.'</span>').'</p>';
1.661     raeburn  10790:                     } else {
1.987     raeburn  10791:                          $output = '<p class="LC_error">'.
                   10792:                                    &mt('Error: could not update [_1].',
                   10793:                                    '<span class="LC_filename">'.
                   10794:                                    $container.'</span>').'</p>';
1.661     raeburn  10795:                     }
                   10796:                 }
                   10797:             }
1.1075.2.35  raeburn  10798:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   10799:                 my ($actionurl,$state);
                   10800:                 $actionurl = "/public/$udom/$uname/syllabus";
                   10801:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   10802:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   10803:                                               \%codebase,
                   10804:                                               {'context' => 'rewrites',
                   10805:                                                'ignore_remote_references' => 1,});
                   10806:                 if (ref($mapping) eq 'HASH') {
                   10807:                     my $rewrites = 0;
                   10808:                     foreach my $key (keys(%{$mapping})) {
                   10809:                         next if ($key =~ m{^https?://});
                   10810:                         my $ref = $mapping->{$key};
                   10811:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   10812:                         my $attrib;
                   10813:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   10814:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   10815:                         }
                   10816:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10817:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10818:                             $rewrites += $numchg;
                   10819:                         }
                   10820:                     }
                   10821:                     if ($rewrites) {
                   10822:                         my $saveresult;
                   10823:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10824:                         if ($url eq $container) {
                   10825:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   10826:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   10827:                                             $count,'<span class="LC_filename">'.
                   10828:                                             $fname.'</span>').'</p>';
                   10829:                         } else {
                   10830:                             $output .= '<p class="LC_error">'.
                   10831:                                        &mt('Error: could not update links in [_1].',
                   10832:                                        '<span class="LC_filename">'.
                   10833:                                        $container.'</span>').'</p>';
                   10834: 
                   10835:                         }
                   10836:                     }
                   10837:                 }
                   10838:             }
1.987     raeburn  10839:         } else {
                   10840:             &logthis('Failed to parse '.$container.
                   10841:                      ' to modify references: '.$parse_result);
1.661     raeburn  10842:         }
                   10843:     }
1.1071    raeburn  10844:     if (wantarray) {
                   10845:         return ($output,$count,$codebasecount);
                   10846:     } else {
                   10847:         return $output;
                   10848:     }
1.661     raeburn  10849: }
                   10850: 
                   10851: sub check_for_existing {
                   10852:     my ($path,$fname,$element) = @_;
                   10853:     my ($state,$msg);
                   10854:     if (-d $path.'/'.$fname) {
                   10855:         $state = 'exists';
                   10856:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10857:     } elsif (-e $path.'/'.$fname) {
                   10858:         $state = 'exists';
                   10859:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10860:     }
                   10861:     if ($state eq 'exists') {
                   10862:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10863:     }
                   10864:     return ($state,$msg);
                   10865: }
                   10866: 
                   10867: sub check_for_upload {
                   10868:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10869:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10870:     my $filesize = length($env{'form.'.$element});
                   10871:     if (!$filesize) {
                   10872:         my $msg = '<span class="LC_error">'.
                   10873:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10874:                       '<span class="LC_filename">'.$fname.'</span>',
                   10875:                       $filesize).'<br />'.
1.1007    raeburn  10876:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10877:                   '</span>';
                   10878:         return ('zero_bytes',$msg);
                   10879:     }
                   10880:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10881:     my $getpropath = 1;
1.1021    raeburn  10882:     my ($dirlistref,$listerror) =
                   10883:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10884:     my $found_file = 0;
                   10885:     my $locked_file = 0;
1.991     raeburn  10886:     my @lockers;
                   10887:     my $navmap;
                   10888:     if ($env{'request.course.id'}) {
                   10889:         $navmap = Apache::lonnavmaps::navmap->new();
                   10890:     }
1.1021    raeburn  10891:     if (ref($dirlistref) eq 'ARRAY') {
                   10892:         foreach my $line (@{$dirlistref}) {
                   10893:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10894:             if ($file_name eq $fname){
                   10895:                 $file_name = $path.$file_name;
                   10896:                 if ($group ne '') {
                   10897:                     $file_name = $group.$file_name;
                   10898:                 }
                   10899:                 $found_file = 1;
                   10900:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10901:                     foreach my $lock (@lockers) {
                   10902:                         if (ref($lock) eq 'ARRAY') {
                   10903:                             my ($symb,$crsid) = @{$lock};
                   10904:                             if ($crsid eq $env{'request.course.id'}) {
                   10905:                                 if (ref($navmap)) {
                   10906:                                     my $res = $navmap->getBySymb($symb);
                   10907:                                     foreach my $part (@{$res->parts()}) { 
                   10908:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10909:                                         unless (($slot_status == $res->RESERVED) ||
                   10910:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10911:                                             $locked_file = 1;
                   10912:                                         }
1.991     raeburn  10913:                                     }
1.1021    raeburn  10914:                                 } else {
                   10915:                                     $locked_file = 1;
1.991     raeburn  10916:                                 }
                   10917:                             } else {
                   10918:                                 $locked_file = 1;
                   10919:                             }
                   10920:                         }
1.1021    raeburn  10921:                    }
                   10922:                 } else {
                   10923:                     my @info = split(/\&/,$rest);
                   10924:                     my $currsize = $info[6]/1000;
                   10925:                     if ($currsize < $filesize) {
                   10926:                         my $extra = $filesize - $currsize;
                   10927:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69  raeburn  10928:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  10929:                                       &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.',
1.1075.2.69  raeburn  10930:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   10931:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10932:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  10933:                             return ('will_exceed_quota',$msg);
                   10934:                         }
1.984     raeburn  10935:                     }
                   10936:                 }
1.661     raeburn  10937:             }
                   10938:         }
                   10939:     }
                   10940:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69  raeburn  10941:         my $msg = '<p class="LC_warning">'.
                   10942:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
                   10943:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  10944:         return ('will_exceed_quota',$msg);
                   10945:     } elsif ($found_file) {
                   10946:         if ($locked_file) {
1.1075.2.69  raeburn  10947:             my $msg = '<p class="LC_warning">';
1.661     raeburn  10948:             $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>');
1.1075.2.69  raeburn  10949:             $msg .= '</p>';
1.661     raeburn  10950:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10951:             return ('file_locked',$msg);
                   10952:         } else {
1.1075.2.69  raeburn  10953:             my $msg = '<p class="LC_error">';
1.984     raeburn  10954:             $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1075.2.69  raeburn  10955:             $msg .= '</p>';
1.984     raeburn  10956:             return ('existingfile',$msg);
1.661     raeburn  10957:         }
                   10958:     }
                   10959: }
                   10960: 
1.987     raeburn  10961: sub check_for_traversal {
                   10962:     my ($path,$url,$toplevel) = @_;
                   10963:     my @parts=split(/\//,$path);
                   10964:     my $cleanpath;
                   10965:     my $fullpath = $url;
                   10966:     for (my $i=0;$i<@parts;$i++) {
                   10967:         next if ($parts[$i] eq '.');
                   10968:         if ($parts[$i] eq '..') {
                   10969:             $fullpath =~ s{([^/]+/)$}{};
                   10970:         } else {
                   10971:             $fullpath .= $parts[$i].'/';
                   10972:         }
                   10973:     }
                   10974:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10975:         $cleanpath = $1;
                   10976:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10977:         my $curr_toprel = $1;
                   10978:         my @parts = split(/\//,$curr_toprel);
                   10979:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10980:         my @urlparts = split(/\//,$url_toprel);
                   10981:         my $doubledots;
                   10982:         my $startdiff = -1;
                   10983:         for (my $i=0; $i<@urlparts; $i++) {
                   10984:             if ($startdiff == -1) {
                   10985:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10986:                     $startdiff = $i;
                   10987:                     $doubledots .= '../';
                   10988:                 }
                   10989:             } else {
                   10990:                 $doubledots .= '../';
                   10991:             }
                   10992:         }
                   10993:         if ($startdiff > -1) {
                   10994:             $cleanpath = $doubledots;
                   10995:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10996:                 $cleanpath .= $parts[$i].'/';
                   10997:             }
                   10998:         }
                   10999:     }
                   11000:     $cleanpath =~ s{(/)$}{};
                   11001:     return $cleanpath;
                   11002: }
1.31      albertel 11003: 
1.1053    raeburn  11004: sub is_archive_file {
                   11005:     my ($mimetype) = @_;
                   11006:     if (($mimetype eq 'application/octet-stream') ||
                   11007:         ($mimetype eq 'application/x-stuffit') ||
                   11008:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11009:         return 1;
                   11010:     }
                   11011:     return;
                   11012: }
                   11013: 
                   11014: sub decompress_form {
1.1065    raeburn  11015:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11016:     my %lt = &Apache::lonlocal::texthash (
                   11017:         this => 'This file is an archive file.',
1.1067    raeburn  11018:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11019:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11020:         youm => 'You may wish to extract its contents.',
                   11021:         extr => 'Extract contents',
1.1067    raeburn  11022:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11023:         proa => 'Process automatically?',
1.1053    raeburn  11024:         yes  => 'Yes',
                   11025:         no   => 'No',
1.1067    raeburn  11026:         fold => 'Title for folder containing movie',
                   11027:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11028:     );
1.1065    raeburn  11029:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11030:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11031:     my $info = &list_archive_contents($fileloc,\@paths);
                   11032:     if (@paths) {
                   11033:         foreach my $path (@paths) {
                   11034:             $path =~ s{^/}{};
1.1067    raeburn  11035:             if ($path =~ m{^([^/]+)/$}) {
                   11036:                 $topdir = $1;
                   11037:             }
1.1065    raeburn  11038:             if ($path =~ m{^([^/]+)/}) {
                   11039:                 $toplevel{$1} = $path;
                   11040:             } else {
                   11041:                 $toplevel{$path} = $path;
                   11042:             }
                   11043:         }
                   11044:     }
1.1067    raeburn  11045:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59  raeburn  11046:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11047:                         "$topdir/media/",
                   11048:                         "$topdir/media/$topdir.mp4",
                   11049:                         "$topdir/media/FirstFrame.png",
                   11050:                         "$topdir/media/player.swf",
                   11051:                         "$topdir/media/swfobject.js",
                   11052:                         "$topdir/media/expressInstall.swf");
1.1075.2.59  raeburn  11053:         my @camtasia8 = ("$topdir/","$topdir/$topdir.html",
                   11054:                          "$topdir/$topdir.mp4",
                   11055:                          "$topdir/$topdir\_config.xml",
                   11056:                          "$topdir/$topdir\_controller.swf",
                   11057:                          "$topdir/$topdir\_embed.css",
                   11058:                          "$topdir/$topdir\_First_Frame.png",
                   11059:                          "$topdir/$topdir\_player.html",
                   11060:                          "$topdir/$topdir\_Thumbnails.png",
                   11061:                          "$topdir/playerProductInstall.swf",
                   11062:                          "$topdir/scripts/",
                   11063:                          "$topdir/scripts/config_xml.js",
                   11064:                          "$topdir/scripts/handlebars.js",
                   11065:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11066:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11067:                          "$topdir/scripts/modernizr.js",
                   11068:                          "$topdir/scripts/player-min.js",
                   11069:                          "$topdir/scripts/swfobject.js",
                   11070:                          "$topdir/skins/",
                   11071:                          "$topdir/skins/configuration_express.xml",
                   11072:                          "$topdir/skins/express_show/",
                   11073:                          "$topdir/skins/express_show/player-min.css",
                   11074:                          "$topdir/skins/express_show/spritesheet.png");
                   11075:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11076:         if (@diffs == 0) {
1.1075.2.59  raeburn  11077:             $is_camtasia = 6;
                   11078:         } else {
                   11079:             @diffs = &compare_arrays(\@paths,\@camtasia8);
                   11080:             if (@diffs == 0) {
                   11081:                 $is_camtasia = 8;
                   11082:             }
1.1067    raeburn  11083:         }
                   11084:     }
                   11085:     my $output;
                   11086:     if ($is_camtasia) {
                   11087:         $output = <<"ENDCAM";
                   11088: <script type="text/javascript" language="Javascript">
                   11089: // <![CDATA[
                   11090: 
                   11091: function camtasiaToggle() {
                   11092:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11093:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59  raeburn  11094:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11095:                 document.getElementById('camtasia_titles').style.display='block';
                   11096:             } else {
                   11097:                 document.getElementById('camtasia_titles').style.display='none';
                   11098:             }
                   11099:         }
                   11100:     }
                   11101:     return;
                   11102: }
                   11103: 
                   11104: // ]]>
                   11105: </script>
                   11106: <p>$lt{'camt'}</p>
                   11107: ENDCAM
1.1065    raeburn  11108:     } else {
1.1067    raeburn  11109:         $output = '<p>'.$lt{'this'};
                   11110:         if ($info eq '') {
                   11111:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11112:         } else {
                   11113:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11114:                        '<div><pre>'.$info.'</pre></div>';
                   11115:         }
1.1065    raeburn  11116:     }
1.1067    raeburn  11117:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11118:     my $duplicates;
                   11119:     my $num = 0;
                   11120:     if (ref($dirlist) eq 'ARRAY') {
                   11121:         foreach my $item (@{$dirlist}) {
                   11122:             if (ref($item) eq 'ARRAY') {
                   11123:                 if (exists($toplevel{$item->[0]})) {
                   11124:                     $duplicates .= 
                   11125:                         &start_data_table_row().
                   11126:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11127:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11128:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11129:                         'value="1" />'.&mt('Yes').'</label>'.
                   11130:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11131:                         '<td>'.$item->[0].'</td>';
                   11132:                     if ($item->[2]) {
                   11133:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11134:                     } else {
                   11135:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11136:                     }
                   11137:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11138:                                    '<td>'.
                   11139:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11140:                                    '</td>'.
                   11141:                                    &end_data_table_row();
                   11142:                     $num ++;
                   11143:                 }
                   11144:             }
                   11145:         }
                   11146:     }
                   11147:     my $itemcount;
                   11148:     if (@paths > 0) {
                   11149:         $itemcount = scalar(@paths);
                   11150:     } else {
                   11151:         $itemcount = 1;
                   11152:     }
1.1067    raeburn  11153:     if ($is_camtasia) {
                   11154:         $output .= $lt{'auto'}.'<br />'.
                   11155:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59  raeburn  11156:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  11157:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11158:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11159:                    $lt{'no'}.'</label></span><br />'.
                   11160:                    '<div id="camtasia_titles" style="display:block">'.
                   11161:                    &Apache::lonhtmlcommon::start_pick_box().
                   11162:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11163:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11164:                    &Apache::lonhtmlcommon::row_closure().
                   11165:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11166:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11167:                    &Apache::lonhtmlcommon::row_closure(1).
                   11168:                    &Apache::lonhtmlcommon::end_pick_box().
                   11169:                    '</div>';
                   11170:     }
1.1065    raeburn  11171:     $output .= 
                   11172:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11173:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11174:         "\n";
1.1065    raeburn  11175:     if ($duplicates ne '') {
                   11176:         $output .= '<p><span class="LC_warning">'.
                   11177:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11178:                    &start_data_table().
                   11179:                    &start_data_table_header_row().
                   11180:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11181:                    '<th>'.&mt('Name').'</th>'.
                   11182:                    '<th>'.&mt('Type').'</th>'.
                   11183:                    '<th>'.&mt('Size').'</th>'.
                   11184:                    '<th>'.&mt('Last modified').'</th>'.
                   11185:                    &end_data_table_header_row().
                   11186:                    $duplicates.
                   11187:                    &end_data_table().
                   11188:                    '</p>';
                   11189:     }
1.1067    raeburn  11190:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11191:     if (ref($hiddenelements) eq 'HASH') {
                   11192:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11193:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11194:         }
                   11195:     }
                   11196:     $output .= <<"END";
1.1067    raeburn  11197: <br />
1.1053    raeburn  11198: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11199: </form>
                   11200: $noextract
                   11201: END
                   11202:     return $output;
                   11203: }
                   11204: 
1.1065    raeburn  11205: sub decompression_utility {
                   11206:     my ($program) = @_;
                   11207:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11208:     my $location;
                   11209:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11210:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11211:                          '/usr/sbin/') {
                   11212:             if (-x $dir.$program) {
                   11213:                 $location = $dir.$program;
                   11214:                 last;
                   11215:             }
                   11216:         }
                   11217:     }
                   11218:     return $location;
                   11219: }
                   11220: 
                   11221: sub list_archive_contents {
                   11222:     my ($file,$pathsref) = @_;
                   11223:     my (@cmd,$output);
                   11224:     my $needsregexp;
                   11225:     if ($file =~ /\.zip$/) {
                   11226:         @cmd = (&decompression_utility('unzip'),"-l");
                   11227:         $needsregexp = 1;
                   11228:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11229:              ($file =~ /\.tgz$/)) {
                   11230:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11231:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11232:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11233:     } elsif ($file =~ m|\.tar$|) {
                   11234:         @cmd = (&decompression_utility('tar'),"-tf");
                   11235:     }
                   11236:     if (@cmd) {
                   11237:         undef($!);
                   11238:         undef($@);
                   11239:         if (open(my $fh,"-|", @cmd, $file)) {
                   11240:             while (my $line = <$fh>) {
                   11241:                 $output .= $line;
                   11242:                 chomp($line);
                   11243:                 my $item;
                   11244:                 if ($needsregexp) {
                   11245:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11246:                 } else {
                   11247:                     $item = $line;
                   11248:                 }
                   11249:                 if ($item ne '') {
                   11250:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11251:                         push(@{$pathsref},$item);
                   11252:                     } 
                   11253:                 }
                   11254:             }
                   11255:             close($fh);
                   11256:         }
                   11257:     }
                   11258:     return $output;
                   11259: }
                   11260: 
1.1053    raeburn  11261: sub decompress_uploaded_file {
                   11262:     my ($file,$dir) = @_;
                   11263:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11264:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11265:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11266:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11267:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11268:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11269:     my $decompressed = $env{'cgi.decompressed'};
                   11270:     &Apache::lonnet::delenv('cgi.file');
                   11271:     &Apache::lonnet::delenv('cgi.dir');
                   11272:     &Apache::lonnet::delenv('cgi.decompressed');
                   11273:     return ($decompressed,$result);
                   11274: }
                   11275: 
1.1055    raeburn  11276: sub process_decompression {
                   11277:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11278:     my ($dir,$error,$warning,$output);
1.1075.2.69  raeburn  11279:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34  raeburn  11280:         $error = &mt('Filename not a supported archive file type.').
                   11281:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11282:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11283:     } else {
                   11284:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11285:         if ($docuhome eq 'no_host') {
                   11286:             $error = &mt('Could not determine home server for course.');
                   11287:         } else {
                   11288:             my @ids=&Apache::lonnet::current_machine_ids();
                   11289:             my $currdir = "$dir_root/$destination";
                   11290:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11291:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11292:                        "$dir_root/$destination";
                   11293:             } else {
                   11294:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11295:                        "$dir_root/$docudom/$docuname/$destination";
                   11296:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11297:                     $error = &mt('Archive file not found.');
                   11298:                 }
                   11299:             }
1.1065    raeburn  11300:             my (@to_overwrite,@to_skip);
                   11301:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11302:                 my $total = $env{'form.archive_overwrite_total'};
                   11303:                 for (my $i=0; $i<$total; $i++) {
                   11304:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11305:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11306:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11307:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11308:                     }
                   11309:                 }
                   11310:             }
                   11311:             my $numskip = scalar(@to_skip);
                   11312:             if (($numskip > 0) && 
                   11313:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11314:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11315:             } elsif ($dir eq '') {
1.1055    raeburn  11316:                 $error = &mt('Directory containing archive file unavailable.');
                   11317:             } elsif (!$error) {
1.1065    raeburn  11318:                 my ($decompressed,$display);
                   11319:                 if ($numskip > 0) {
                   11320:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11321:                     mkdir("$dir/$tempdir",0755);
                   11322:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11323:                     ($decompressed,$display) = 
                   11324:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11325:                     foreach my $item (@to_skip) {
                   11326:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11327:                             if (-f "$dir/$tempdir/$item") { 
                   11328:                                 unlink("$dir/$tempdir/$item");
                   11329:                             } elsif (-d "$dir/$tempdir/$item") {
                   11330:                                 system("rm -rf $dir/$tempdir/$item");
                   11331:                             }
                   11332:                         }
                   11333:                     }
                   11334:                     system("mv $dir/$tempdir/* $dir");
                   11335:                     rmdir("$dir/$tempdir");   
                   11336:                 } else {
                   11337:                     ($decompressed,$display) = 
                   11338:                         &decompress_uploaded_file($file,$dir);
                   11339:                 }
1.1055    raeburn  11340:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11341:                     $output = '<p class="LC_info">'.
                   11342:                               &mt('Files extracted successfully from archive.').
                   11343:                               '</p>'."\n";
1.1055    raeburn  11344:                     my ($warning,$result,@contents);
                   11345:                     my ($newdirlistref,$newlisterror) =
                   11346:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11347:                                                  $docuname,1);
                   11348:                     my (%is_dir,%changes,@newitems);
                   11349:                     my $dirptr = 16384;
1.1065    raeburn  11350:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11351:                         foreach my $dir_line (@{$newdirlistref}) {
                   11352:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11353:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11354:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11355:                                 push(@newitems,$item);
                   11356:                                 if ($dirptr&$testdir) {
                   11357:                                     $is_dir{$item} = 1;
                   11358:                                 }
                   11359:                                 $changes{$item} = 1;
                   11360:                             }
                   11361:                         }
                   11362:                     }
                   11363:                     if (keys(%changes) > 0) {
                   11364:                         foreach my $item (sort(@newitems)) {
                   11365:                             if ($changes{$item}) {
                   11366:                                 push(@contents,$item);
                   11367:                             }
                   11368:                         }
                   11369:                     }
                   11370:                     if (@contents > 0) {
1.1067    raeburn  11371:                         my $wantform;
                   11372:                         unless ($env{'form.autoextract_camtasia'}) {
                   11373:                             $wantform = 1;
                   11374:                         }
1.1056    raeburn  11375:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11376:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11377:                                                                 $currdir,\%is_dir,
                   11378:                                                                 \%children,\%parent,
1.1056    raeburn  11379:                                                                 \@contents,\%dirorder,
                   11380:                                                                 \%titles,$wantform);
1.1055    raeburn  11381:                         if ($datatable ne '') {
                   11382:                             $output .= &archive_options_form('decompressed',$datatable,
                   11383:                                                              $count,$hiddenelem);
1.1065    raeburn  11384:                             my $startcount = 6;
1.1055    raeburn  11385:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11386:                                                            \%titles,\%children);
1.1055    raeburn  11387:                         }
1.1067    raeburn  11388:                         if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59  raeburn  11389:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  11390:                             my %displayed;
                   11391:                             my $total = 1;
                   11392:                             $env{'form.archive_directory'} = [];
                   11393:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11394:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11395:                                 $path =~ s{/$}{};
                   11396:                                 my $item;
                   11397:                                 if ($path ne '') {
                   11398:                                     $item = "$path/$titles{$i}";
                   11399:                                 } else {
                   11400:                                     $item = $titles{$i};
                   11401:                                 }
                   11402:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11403:                                 if ($item eq $contents[0]) {
                   11404:                                     push(@{$env{'form.archive_directory'}},$i);
                   11405:                                     $env{'form.archive_'.$i} = 'display';
                   11406:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11407:                                     $displayed{'folder'} = $i;
1.1075.2.59  raeburn  11408:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   11409:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067    raeburn  11410:                                     $env{'form.archive_'.$i} = 'display';
                   11411:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11412:                                     $displayed{'web'} = $i;
                   11413:                                 } else {
1.1075.2.59  raeburn  11414:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   11415:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   11416:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  11417:                                         push(@{$env{'form.archive_directory'}},$i);
                   11418:                                     }
                   11419:                                     $env{'form.archive_'.$i} = 'dependency';
                   11420:                                 }
                   11421:                                 $total ++;
                   11422:                             }
                   11423:                             for (my $i=1; $i<$total; $i++) {
                   11424:                                 next if ($i == $displayed{'web'});
                   11425:                                 next if ($i == $displayed{'folder'});
                   11426:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11427:                             }
                   11428:                             $env{'form.phase'} = 'decompress_cleanup';
                   11429:                             $env{'form.archivedelete'} = 1;
                   11430:                             $env{'form.archive_count'} = $total-1;
                   11431:                             $output .=
                   11432:                                 &process_extracted_files('coursedocs',$docudom,
                   11433:                                                          $docuname,$destination,
                   11434:                                                          $dir_root,$hiddenelem);
                   11435:                         }
1.1055    raeburn  11436:                     } else {
                   11437:                         $warning = &mt('No new items extracted from archive file.');
                   11438:                     }
                   11439:                 } else {
                   11440:                     $output = $display;
                   11441:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11442:                 }
                   11443:             }
                   11444:         }
                   11445:     }
                   11446:     if ($error) {
                   11447:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11448:                    $error.'</p>'."\n";
                   11449:     }
                   11450:     if ($warning) {
                   11451:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11452:     }
                   11453:     return $output;
                   11454: }
                   11455: 
                   11456: sub get_extracted {
1.1056    raeburn  11457:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11458:         $titles,$wantform) = @_;
1.1055    raeburn  11459:     my $count = 0;
                   11460:     my $depth = 0;
                   11461:     my $datatable;
1.1056    raeburn  11462:     my @hierarchy;
1.1055    raeburn  11463:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11464:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11465:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11466:     foreach my $item (@{$contents}) {
                   11467:         $count ++;
1.1056    raeburn  11468:         @{$dirorder->{$count}} = @hierarchy;
                   11469:         $titles->{$count} = $item;
1.1055    raeburn  11470:         &archive_hierarchy($depth,$count,$parent,$children);
                   11471:         if ($wantform) {
                   11472:             $datatable .= &archive_row($is_dir->{$item},$item,
                   11473:                                        $currdir,$depth,$count);
                   11474:         }
                   11475:         if ($is_dir->{$item}) {
                   11476:             $depth ++;
1.1056    raeburn  11477:             push(@hierarchy,$count);
                   11478:             $parent->{$depth} = $count;
1.1055    raeburn  11479:             $datatable .=
                   11480:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  11481:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   11482:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  11483:             $depth --;
1.1056    raeburn  11484:             pop(@hierarchy);
1.1055    raeburn  11485:         }
                   11486:     }
                   11487:     return ($count,$datatable);
                   11488: }
                   11489: 
                   11490: sub recurse_extracted_archive {
1.1056    raeburn  11491:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   11492:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  11493:     my $result='';
1.1056    raeburn  11494:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   11495:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   11496:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  11497:         return $result;
                   11498:     }
                   11499:     my $dirptr = 16384;
                   11500:     my ($newdirlistref,$newlisterror) =
                   11501:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   11502:     if (ref($newdirlistref) eq 'ARRAY') {
                   11503:         foreach my $dir_line (@{$newdirlistref}) {
                   11504:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   11505:             unless ($item =~ /^\.+$/) {
                   11506:                 $$count ++;
1.1056    raeburn  11507:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   11508:                 $titles->{$$count} = $item;
1.1055    raeburn  11509:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  11510: 
1.1055    raeburn  11511:                 my $is_dir;
                   11512:                 if ($dirptr&$testdir) {
                   11513:                     $is_dir = 1;
                   11514:                 }
                   11515:                 if ($wantform) {
                   11516:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11517:                 }
                   11518:                 if ($is_dir) {
                   11519:                     $$depth ++;
1.1056    raeburn  11520:                     push(@{$hierarchy},$$count);
                   11521:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11522:                     $result .=
                   11523:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11524:                                                    $docuname,$depth,$count,
1.1056    raeburn  11525:                                                    $hierarchy,$dirorder,$children,
                   11526:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11527:                     $$depth --;
1.1056    raeburn  11528:                     pop(@{$hierarchy});
1.1055    raeburn  11529:                 }
                   11530:             }
                   11531:         }
                   11532:     }
                   11533:     return $result;
                   11534: }
                   11535: 
                   11536: sub archive_hierarchy {
                   11537:     my ($depth,$count,$parent,$children) =@_;
                   11538:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11539:         if (exists($parent->{$depth})) {
                   11540:              $children->{$parent->{$depth}} .= $count.':';
                   11541:         }
                   11542:     }
                   11543:     return;
                   11544: }
                   11545: 
                   11546: sub archive_row {
                   11547:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11548:     my ($name) = ($item =~ m{([^/]+)$});
                   11549:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11550:                                        'display'    => 'Add as file',
1.1055    raeburn  11551:                                        'dependency' => 'Include as dependency',
                   11552:                                        'discard'    => 'Discard',
                   11553:                                       );
                   11554:     if ($is_dir) {
1.1059    raeburn  11555:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11556:     }
1.1056    raeburn  11557:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11558:     my $offset = 0;
1.1055    raeburn  11559:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11560:         $offset ++;
1.1065    raeburn  11561:         if ($action ne 'display') {
                   11562:             $offset ++;
                   11563:         }  
1.1055    raeburn  11564:         $output .= '<td><span class="LC_nobreak">'.
                   11565:                    '<label><input type="radio" name="archive_'.$count.
                   11566:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11567:         my $text = $choices{$action};
                   11568:         if ($is_dir) {
                   11569:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11570:             if ($action eq 'display') {
1.1059    raeburn  11571:                 $text = &mt('Add as folder');
1.1055    raeburn  11572:             }
1.1056    raeburn  11573:         } else {
                   11574:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11575: 
                   11576:         }
                   11577:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11578:         if ($action eq 'dependency') {
                   11579:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11580:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11581:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11582:                        '<option value=""></option>'."\n".
                   11583:                        '</select>'."\n".
                   11584:                        '</div>';
1.1059    raeburn  11585:         } elsif ($action eq 'display') {
                   11586:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11587:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11588:                        '</div>';
1.1055    raeburn  11589:         }
1.1056    raeburn  11590:         $output .= '</td>';
1.1055    raeburn  11591:     }
                   11592:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11593:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11594:     for (my $i=0; $i<$depth; $i++) {
                   11595:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11596:     }
                   11597:     if ($is_dir) {
                   11598:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11599:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11600:     } else {
                   11601:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11602:     }
                   11603:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11604:                &end_data_table_row();
                   11605:     return $output;
                   11606: }
                   11607: 
                   11608: sub archive_options_form {
1.1065    raeburn  11609:     my ($form,$display,$count,$hiddenelem) = @_;
                   11610:     my %lt = &Apache::lonlocal::texthash(
                   11611:                perm => 'Permanently remove archive file?',
                   11612:                hows => 'How should each extracted item be incorporated in the course?',
                   11613:                cont => 'Content actions for all',
                   11614:                addf => 'Add as folder/file',
                   11615:                incd => 'Include as dependency for a displayed file',
                   11616:                disc => 'Discard',
                   11617:                no   => 'No',
                   11618:                yes  => 'Yes',
                   11619:                save => 'Save',
                   11620:     );
                   11621:     my $output = <<"END";
                   11622: <form name="$form" method="post" action="">
                   11623: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11624: <label>
                   11625:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11626: </label>
                   11627: &nbsp;
                   11628: <label>
                   11629:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11630: </span>
                   11631: </p>
                   11632: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11633: <br />$lt{'hows'}
                   11634: <div class="LC_columnSection">
                   11635:   <fieldset>
                   11636:     <legend>$lt{'cont'}</legend>
                   11637:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11638:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11639:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11640:   </fieldset>
                   11641: </div>
                   11642: END
                   11643:     return $output.
1.1055    raeburn  11644:            &start_data_table()."\n".
1.1065    raeburn  11645:            $display."\n".
1.1055    raeburn  11646:            &end_data_table()."\n".
                   11647:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11648:            $hiddenelem.
1.1065    raeburn  11649:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11650:            '</form>';
                   11651: }
                   11652: 
                   11653: sub archive_javascript {
1.1056    raeburn  11654:     my ($startcount,$numitems,$titles,$children) = @_;
                   11655:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11656:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11657:     my $scripttag = <<START;
                   11658: <script type="text/javascript">
                   11659: // <![CDATA[
                   11660: 
                   11661: function checkAll(form,prefix) {
                   11662:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11663:     for (var i=0; i < form.elements.length; i++) {
                   11664:         var id = form.elements[i].id;
                   11665:         if ((id != '') && (id != undefined)) {
                   11666:             if (idstr.test(id)) {
                   11667:                 if (form.elements[i].type == 'radio') {
                   11668:                     form.elements[i].checked = true;
1.1056    raeburn  11669:                     var nostart = i-$startcount;
1.1059    raeburn  11670:                     var offset = nostart%7;
                   11671:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11672:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11673:                 }
                   11674:             }
                   11675:         }
                   11676:     }
                   11677: }
                   11678: 
                   11679: function propagateCheck(form,count) {
                   11680:     if (count > 0) {
1.1059    raeburn  11681:         var startelement = $startcount + ((count-1) * 7);
                   11682:         for (var j=1; j<6; j++) {
                   11683:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11684:                 var item = startelement + j; 
                   11685:                 if (form.elements[item].type == 'radio') {
                   11686:                     if (form.elements[item].checked) {
                   11687:                         containerCheck(form,count,j);
                   11688:                         break;
                   11689:                     }
1.1055    raeburn  11690:                 }
                   11691:             }
                   11692:         }
                   11693:     }
                   11694: }
                   11695: 
                   11696: numitems = $numitems
1.1056    raeburn  11697: var titles = new Array(numitems);
                   11698: var parents = new Array(numitems);
1.1055    raeburn  11699: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11700:     parents[i] = new Array;
1.1055    raeburn  11701: }
1.1059    raeburn  11702: var maintitle = '$maintitle';
1.1055    raeburn  11703: 
                   11704: START
                   11705: 
1.1056    raeburn  11706:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11707:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11708:         for (my $i=0; $i<@contents; $i ++) {
                   11709:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11710:         }
                   11711:     }
                   11712: 
1.1056    raeburn  11713:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11714:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11715:     }
                   11716: 
1.1055    raeburn  11717:     $scripttag .= <<END;
                   11718: 
                   11719: function containerCheck(form,count,offset) {
                   11720:     if (count > 0) {
1.1056    raeburn  11721:         dependencyCheck(form,count,offset);
1.1059    raeburn  11722:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11723:         form.elements[item].checked = true;
                   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++) {
1.1056    raeburn  11727:                     containerCheck(form,parents[count][j],offset);
                   11728:                 }
                   11729:             }
                   11730:         }
                   11731:     }
                   11732: }
                   11733: 
                   11734: function dependencyCheck(form,count,offset) {
                   11735:     if (count > 0) {
1.1059    raeburn  11736:         var chosen = (offset+$startcount)+7*(count-1);
                   11737:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11738:         var currtype = form.elements[depitem].type;
                   11739:         if (form.elements[chosen].value == 'dependency') {
                   11740:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11741:             form.elements[depitem].options.length = 0;
                   11742:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  11743:             for (var i=1; i<=numitems; i++) {
                   11744:                 if (i == count) {
                   11745:                     continue;
                   11746:                 }
1.1059    raeburn  11747:                 var startelement = $startcount + (i-1) * 7;
                   11748:                 for (var j=1; j<6; j++) {
                   11749:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11750:                         var item = startelement + j;
                   11751:                         if (form.elements[item].type == 'radio') {
                   11752:                             if (form.elements[item].checked) {
                   11753:                                 if (form.elements[item].value == 'display') {
                   11754:                                     var n = form.elements[depitem].options.length;
                   11755:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11756:                                 }
                   11757:                             }
                   11758:                         }
                   11759:                     }
                   11760:                 }
                   11761:             }
                   11762:         } else {
                   11763:             document.getElementById('arc_depon_'+count).style.display='none';
                   11764:             form.elements[depitem].options.length = 0;
                   11765:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11766:         }
1.1059    raeburn  11767:         titleCheck(form,count,offset);
1.1056    raeburn  11768:     }
                   11769: }
                   11770: 
                   11771: function propagateSelect(form,count,offset) {
                   11772:     if (count > 0) {
1.1065    raeburn  11773:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11774:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11775:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11776:             if (parents[count].length > 0) {
                   11777:                 for (var j=0; j<parents[count].length; j++) {
                   11778:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11779:                 }
                   11780:             }
                   11781:         }
                   11782:     }
                   11783: }
1.1056    raeburn  11784: 
                   11785: function containerSelect(form,count,offset,picked) {
                   11786:     if (count > 0) {
1.1065    raeburn  11787:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11788:         if (form.elements[item].type == 'radio') {
                   11789:             if (form.elements[item].value == 'dependency') {
                   11790:                 if (form.elements[item+1].type == 'select-one') {
                   11791:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11792:                         if (form.elements[item+1].options[i].value == picked) {
                   11793:                             form.elements[item+1].selectedIndex = i;
                   11794:                             break;
                   11795:                         }
                   11796:                     }
                   11797:                 }
                   11798:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11799:                     if (parents[count].length > 0) {
                   11800:                         for (var j=0; j<parents[count].length; j++) {
                   11801:                             containerSelect(form,parents[count][j],offset,picked);
                   11802:                         }
                   11803:                     }
                   11804:                 }
                   11805:             }
                   11806:         }
                   11807:     }
                   11808: }
                   11809: 
1.1059    raeburn  11810: function titleCheck(form,count,offset) {
                   11811:     if (count > 0) {
                   11812:         var chosen = (offset+$startcount)+7*(count-1);
                   11813:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11814:         var currtype = form.elements[depitem].type;
                   11815:         if (form.elements[chosen].value == 'display') {
                   11816:             document.getElementById('arc_title_'+count).style.display='block';
                   11817:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11818:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11819:             }
                   11820:         } else {
                   11821:             document.getElementById('arc_title_'+count).style.display='none';
                   11822:             if (currtype == 'text') { 
                   11823:                 document.getElementById('archive_title_'+count).value='';
                   11824:             }
                   11825:         }
                   11826:     }
                   11827:     return;
                   11828: }
                   11829: 
1.1055    raeburn  11830: // ]]>
                   11831: </script>
                   11832: END
                   11833:     return $scripttag;
                   11834: }
                   11835: 
                   11836: sub process_extracted_files {
1.1067    raeburn  11837:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11838:     my $numitems = $env{'form.archive_count'};
                   11839:     return unless ($numitems);
                   11840:     my @ids=&Apache::lonnet::current_machine_ids();
                   11841:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11842:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11843:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11844:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11845:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11846:         $pathtocheck = "$dir_root/$destination";
                   11847:         $dir = $dir_root;
                   11848:         $ishome = 1;
                   11849:     } else {
                   11850:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11851:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11852:         $dir = "$dir_root/$docudom/$docuname";    
                   11853:     }
                   11854:     my $currdir = "$dir_root/$destination";
                   11855:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11856:     if ($env{'form.folderpath'}) {
                   11857:         my @items = split('&',$env{'form.folderpath'});
                   11858:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  11859:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11860:             $containers{'0'}='page';
                   11861:         } else {
                   11862:             $containers{'0'}='sequence';
                   11863:         }
1.1055    raeburn  11864:     }
                   11865:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11866:     if ($numitems) {
                   11867:         for (my $i=1; $i<=$numitems; $i++) {
                   11868:             my $path = $env{'form.archive_content_'.$i};
                   11869:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11870:                 my $item = $1;
                   11871:                 $toplevelitems{$item} = $i;
                   11872:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11873:                     $is_dir{$item} = 1;
                   11874:                 }
                   11875:             }
                   11876:         }
                   11877:     }
1.1067    raeburn  11878:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11879:     if (keys(%toplevelitems) > 0) {
                   11880:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11881:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11882:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11883:     }
1.1066    raeburn  11884:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11885:     if ($numitems) {
                   11886:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  11887:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11888:             my $path = $env{'form.archive_content_'.$i};
                   11889:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11890:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11891:                     if ($prefix ne '' && $path ne '') {
                   11892:                         if (-e $prefix.$path) {
1.1066    raeburn  11893:                             if ((@archdirs > 0) && 
                   11894:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11895:                                 $todeletedir{$prefix.$path} = 1;
                   11896:                             } else {
                   11897:                                 $todelete{$prefix.$path} = 1;
                   11898:                             }
1.1055    raeburn  11899:                         }
                   11900:                     }
                   11901:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11902:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11903:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11904:                     $docstitle = $env{'form.archive_title_'.$i};
                   11905:                     if ($docstitle eq '') {
                   11906:                         $docstitle = $title;
                   11907:                     }
1.1055    raeburn  11908:                     $outer = 0;
1.1056    raeburn  11909:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11910:                         if (@{$dirorder{$i}} > 0) {
                   11911:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11912:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11913:                                     $outer = $item;
                   11914:                                     last;
                   11915:                                 }
                   11916:                             }
                   11917:                         }
                   11918:                     }
                   11919:                     my ($errtext,$fatal) = 
                   11920:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11921:                                                '/'.$folders{$outer}.'.'.
                   11922:                                                $containers{$outer});
                   11923:                     next if ($fatal);
                   11924:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11925:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11926:                             $mapinner{$i} = time;
1.1055    raeburn  11927:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11928:                             $containers{$i} = 'sequence';
                   11929:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11930:                                       $folders{$i}.'.'.$containers{$i};
                   11931:                             my $newidx = &LONCAPA::map::getresidx();
                   11932:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11933:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11934:                             push(@LONCAPA::map::order,$newidx);
                   11935:                             my ($outtext,$errtext) =
                   11936:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11937:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11938:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11939:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11940:                             unless ($errtext) {
                   11941:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11942:                             }
1.1055    raeburn  11943:                         }
                   11944:                     } else {
                   11945:                         if ($context eq 'coursedocs') {
                   11946:                             my $newidx=&LONCAPA::map::getresidx();
                   11947:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11948:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11949:                                       $title;
                   11950:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11951:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11952:                             }
                   11953:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11954:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11955:                             }
                   11956:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11957:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11958:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11959:                                 unless ($ishome) {
                   11960:                                     my $fetch = "$newdest{$i}/$title";
                   11961:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11962:                                     $prompttofetch{$fetch} = 1;
                   11963:                                 }
1.1055    raeburn  11964:                             }
                   11965:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11966:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11967:                             push(@LONCAPA::map::order, $newidx);
                   11968:                             my ($outtext,$errtext)=
                   11969:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11970:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11971:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11972:                             unless ($errtext) {
                   11973:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11974:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11975:                                 }
                   11976:                             }
1.1055    raeburn  11977:                         }
                   11978:                     }
1.1075.2.11  raeburn  11979:                 }
                   11980:             } else {
                   11981:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                   11982:             }
                   11983:         }
                   11984:         for (my $i=1; $i<=$numitems; $i++) {
                   11985:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11986:             my $path = $env{'form.archive_content_'.$i};
                   11987:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11988:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11989:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11990:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11991:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11992:                         my ($itemidx,$fullpath,$relpath);
                   11993:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11994:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11995:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  11996:                                 if ($dirorder{$i}->[$j] eq $container) {
                   11997:                                     $itemidx = $j;
1.1056    raeburn  11998:                                 }
                   11999:                             }
1.1075.2.11  raeburn  12000:                         }
                   12001:                         if ($itemidx eq '') {
                   12002:                             $itemidx =  0;
                   12003:                         }
                   12004:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12005:                             if ($mapinner{$referrer{$i}}) {
                   12006:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12007:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12008:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12009:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12010:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12011:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12012:                                             if (!-e $fullpath) {
                   12013:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12014:                                             }
                   12015:                                         }
1.1075.2.11  raeburn  12016:                                     } else {
                   12017:                                         last;
1.1056    raeburn  12018:                                     }
1.1075.2.11  raeburn  12019:                                 }
                   12020:                             }
                   12021:                         } elsif ($newdest{$referrer{$i}}) {
                   12022:                             $fullpath = $newdest{$referrer{$i}};
                   12023:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12024:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12025:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12026:                                     last;
                   12027:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12028:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12029:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12030:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12031:                                         if (!-e $fullpath) {
                   12032:                                             mkdir($fullpath,0755);
1.1056    raeburn  12033:                                         }
                   12034:                                     }
1.1075.2.11  raeburn  12035:                                 } else {
                   12036:                                     last;
1.1056    raeburn  12037:                                 }
1.1075.2.11  raeburn  12038:                             }
                   12039:                         }
                   12040:                         if ($fullpath ne '') {
                   12041:                             if (-e "$prefix$path") {
                   12042:                                 system("mv $prefix$path $fullpath/$title");
                   12043:                             }
                   12044:                             if (-e "$fullpath/$title") {
                   12045:                                 my $showpath;
                   12046:                                 if ($relpath ne '') {
                   12047:                                     $showpath = "$relpath/$title";
                   12048:                                 } else {
                   12049:                                     $showpath = "/$title";
1.1056    raeburn  12050:                                 }
1.1075.2.11  raeburn  12051:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   12052:                             }
                   12053:                             unless ($ishome) {
                   12054:                                 my $fetch = "$fullpath/$title";
                   12055:                                 $fetch =~ s/^\Q$prefix$dir\E//;
                   12056:                                 $prompttofetch{$fetch} = 1;
1.1055    raeburn  12057:                             }
                   12058:                         }
                   12059:                     }
1.1075.2.11  raeburn  12060:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12061:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   12062:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  12063:                 }
                   12064:             } else {
1.1075.2.11  raeburn  12065:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055    raeburn  12066:             }
                   12067:         }
                   12068:         if (keys(%todelete)) {
                   12069:             foreach my $key (keys(%todelete)) {
                   12070:                 unlink($key);
1.1066    raeburn  12071:             }
                   12072:         }
                   12073:         if (keys(%todeletedir)) {
                   12074:             foreach my $key (keys(%todeletedir)) {
                   12075:                 rmdir($key);
                   12076:             }
                   12077:         }
                   12078:         foreach my $dir (sort(keys(%is_dir))) {
                   12079:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12080:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12081:             }
                   12082:         }
1.1067    raeburn  12083:         if ($result ne '') {
                   12084:             $output .= '<ul>'."\n".
                   12085:                        $result."\n".
                   12086:                        '</ul>';
                   12087:         }
                   12088:         unless ($ishome) {
                   12089:             my $replicationfail;
                   12090:             foreach my $item (keys(%prompttofetch)) {
                   12091:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12092:                 unless ($fetchresult eq 'ok') {
                   12093:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12094:                 }
                   12095:             }
                   12096:             if ($replicationfail) {
                   12097:                 $output .= '<p class="LC_error">'.
                   12098:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12099:                            $replicationfail.
                   12100:                            '</ul></p>';
                   12101:             }
                   12102:         }
1.1055    raeburn  12103:     } else {
                   12104:         $warning = &mt('No items found in archive.');
                   12105:     }
                   12106:     if ($error) {
                   12107:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12108:                    $error.'</p>'."\n";
                   12109:     }
                   12110:     if ($warning) {
                   12111:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12112:     }
                   12113:     return $output;
                   12114: }
                   12115: 
1.1066    raeburn  12116: sub cleanup_empty_dirs {
                   12117:     my ($path) = @_;
                   12118:     if (($path ne '') && (-d $path)) {
                   12119:         if (opendir(my $dirh,$path)) {
                   12120:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12121:             my $numitems = 0;
                   12122:             foreach my $item (@dircontents) {
                   12123:                 if (-d "$path/$item") {
1.1075.2.28  raeburn  12124:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12125:                     if (-e "$path/$item") {
                   12126:                         $numitems ++;
                   12127:                     }
                   12128:                 } else {
                   12129:                     $numitems ++;
                   12130:                 }
                   12131:             }
                   12132:             if ($numitems == 0) {
                   12133:                 rmdir($path);
                   12134:             }
                   12135:             closedir($dirh);
                   12136:         }
                   12137:     }
                   12138:     return;
                   12139: }
                   12140: 
1.41      ng       12141: =pod
1.45      matthew  12142: 
1.1075.2.56  raeburn  12143: =item * &get_folder_hierarchy()
1.1068    raeburn  12144: 
                   12145: Provides hierarchy of names of folders/sub-folders containing the current
                   12146: item,
                   12147: 
                   12148: Inputs: 3
                   12149:      - $navmap - navmaps object
                   12150: 
                   12151:      - $map - url for map (either the trigger itself, or map containing
                   12152:                            the resource, which is the trigger).
                   12153: 
                   12154:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12155: 
                   12156: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12157: 
                   12158: =cut
                   12159: 
                   12160: sub get_folder_hierarchy {
                   12161:     my ($navmap,$map,$showitem) = @_;
                   12162:     my @pathitems;
                   12163:     if (ref($navmap)) {
                   12164:         my $mapres = $navmap->getResourceByUrl($map);
                   12165:         if (ref($mapres)) {
                   12166:             my $pcslist = $mapres->map_hierarchy();
                   12167:             if ($pcslist ne '') {
                   12168:                 my @pcs = split(/,/,$pcslist);
                   12169:                 foreach my $pc (@pcs) {
                   12170:                     if ($pc == 1) {
1.1075.2.38  raeburn  12171:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12172:                     } else {
                   12173:                         my $res = $navmap->getByMapPc($pc);
                   12174:                         if (ref($res)) {
                   12175:                             my $title = $res->compTitle();
                   12176:                             $title =~ s/\W+/_/g;
                   12177:                             if ($title ne '') {
                   12178:                                 push(@pathitems,$title);
                   12179:                             }
                   12180:                         }
                   12181:                     }
                   12182:                 }
                   12183:             }
1.1071    raeburn  12184:             if ($showitem) {
                   12185:                 if ($mapres->{ID} eq '0.0') {
1.1075.2.38  raeburn  12186:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12187:                 } else {
                   12188:                     my $maptitle = $mapres->compTitle();
                   12189:                     $maptitle =~ s/\W+/_/g;
                   12190:                     if ($maptitle ne '') {
                   12191:                         push(@pathitems,$maptitle);
                   12192:                     }
1.1068    raeburn  12193:                 }
                   12194:             }
                   12195:         }
                   12196:     }
                   12197:     return @pathitems;
                   12198: }
                   12199: 
                   12200: =pod
                   12201: 
1.1015    raeburn  12202: =item * &get_turnedin_filepath()
                   12203: 
                   12204: Determines path in a user's portfolio file for storage of files uploaded
                   12205: to a specific essayresponse or dropbox item.
                   12206: 
                   12207: Inputs: 3 required + 1 optional.
                   12208: $symb is symb for resource, $uname and $udom are for current user (required).
                   12209: $caller is optional (can be "submission", if routine is called when storing
                   12210: an upoaded file when "Submit Answer" button was pressed).
                   12211: 
                   12212: Returns array containing $path and $multiresp. 
                   12213: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12214: than one file upload item.  Callers of routine should append partid as a 
                   12215: subdirectory to $path in cases where $multiresp is 1.
                   12216: 
                   12217: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12218: 
                   12219: =cut
                   12220: 
                   12221: sub get_turnedin_filepath {
                   12222:     my ($symb,$uname,$udom,$caller) = @_;
                   12223:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12224:     my $turnindir;
                   12225:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12226:     $turnindir = $userhash{'turnindir'};
                   12227:     my ($path,$multiresp);
                   12228:     if ($turnindir eq '') {
                   12229:         if ($caller eq 'submission') {
                   12230:             $turnindir = &mt('turned in');
                   12231:             $turnindir =~ s/\W+/_/g;
                   12232:             my %newhash = (
                   12233:                             'turnindir' => $turnindir,
                   12234:                           );
                   12235:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12236:         }
                   12237:     }
                   12238:     if ($turnindir ne '') {
                   12239:         $path = '/'.$turnindir.'/';
                   12240:         my ($multipart,$turnin,@pathitems);
                   12241:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12242:         if (defined($navmap)) {
                   12243:             my $mapres = $navmap->getResourceByUrl($map);
                   12244:             if (ref($mapres)) {
                   12245:                 my $pcslist = $mapres->map_hierarchy();
                   12246:                 if ($pcslist ne '') {
                   12247:                     foreach my $pc (split(/,/,$pcslist)) {
                   12248:                         my $res = $navmap->getByMapPc($pc);
                   12249:                         if (ref($res)) {
                   12250:                             my $title = $res->compTitle();
                   12251:                             $title =~ s/\W+/_/g;
                   12252:                             if ($title ne '') {
1.1075.2.48  raeburn  12253:                                 if (($pc > 1) && (length($title) > 12)) {
                   12254:                                     $title = substr($title,0,12);
                   12255:                                 }
1.1015    raeburn  12256:                                 push(@pathitems,$title);
                   12257:                             }
                   12258:                         }
                   12259:                     }
                   12260:                 }
                   12261:                 my $maptitle = $mapres->compTitle();
                   12262:                 $maptitle =~ s/\W+/_/g;
                   12263:                 if ($maptitle ne '') {
1.1075.2.48  raeburn  12264:                     if (length($maptitle) > 12) {
                   12265:                         $maptitle = substr($maptitle,0,12);
                   12266:                     }
1.1015    raeburn  12267:                     push(@pathitems,$maptitle);
                   12268:                 }
                   12269:                 unless ($env{'request.state'} eq 'construct') {
                   12270:                     my $res = $navmap->getBySymb($symb);
                   12271:                     if (ref($res)) {
                   12272:                         my $partlist = $res->parts();
                   12273:                         my $totaluploads = 0;
                   12274:                         if (ref($partlist) eq 'ARRAY') {
                   12275:                             foreach my $part (@{$partlist}) {
                   12276:                                 my @types = $res->responseType($part);
                   12277:                                 my @ids = $res->responseIds($part);
                   12278:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12279:                                     if ($types[$i] eq 'essay') {
                   12280:                                         my $partid = $part.'_'.$ids[$i];
                   12281:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12282:                                             $totaluploads ++;
                   12283:                                         }
                   12284:                                     }
                   12285:                                 }
                   12286:                             }
                   12287:                             if ($totaluploads > 1) {
                   12288:                                 $multiresp = 1;
                   12289:                             }
                   12290:                         }
                   12291:                     }
                   12292:                 }
                   12293:             } else {
                   12294:                 return;
                   12295:             }
                   12296:         } else {
                   12297:             return;
                   12298:         }
                   12299:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12300:         $restitle =~ s/\W+/_/g;
                   12301:         if ($restitle eq '') {
                   12302:             $restitle = ($resurl =~ m{/[^/]+$});
                   12303:             if ($restitle eq '') {
                   12304:                 $restitle = time;
                   12305:             }
                   12306:         }
1.1075.2.48  raeburn  12307:         if (length($restitle) > 12) {
                   12308:             $restitle = substr($restitle,0,12);
                   12309:         }
1.1015    raeburn  12310:         push(@pathitems,$restitle);
                   12311:         $path .= join('/',@pathitems);
                   12312:     }
                   12313:     return ($path,$multiresp);
                   12314: }
                   12315: 
                   12316: =pod
                   12317: 
1.464     albertel 12318: =back
1.41      ng       12319: 
1.112     bowersj2 12320: =head1 CSV Upload/Handling functions
1.38      albertel 12321: 
1.41      ng       12322: =over 4
                   12323: 
1.648     raeburn  12324: =item * &upfile_store($r)
1.41      ng       12325: 
                   12326: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12327: needs $env{'form.upfile'}
1.41      ng       12328: returns $datatoken to be put into hidden field
                   12329: 
                   12330: =cut
1.31      albertel 12331: 
                   12332: sub upfile_store {
                   12333:     my $r=shift;
1.258     albertel 12334:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12335:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12336:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12337:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12338: 
1.258     albertel 12339:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12340: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12341:     {
1.158     raeburn  12342:         my $datafile = $r->dir_config('lonDaemons').
                   12343:                            '/tmp/'.$datatoken.'.tmp';
                   12344:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12345:             print $fh $env{'form.upfile'};
1.158     raeburn  12346:             close($fh);
                   12347:         }
1.31      albertel 12348:     }
                   12349:     return $datatoken;
                   12350: }
                   12351: 
1.56      matthew  12352: =pod
                   12353: 
1.648     raeburn  12354: =item * &load_tmp_file($r)
1.41      ng       12355: 
                   12356: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12357: needs $env{'form.datatoken'},
                   12358: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12359: 
                   12360: =cut
1.31      albertel 12361: 
                   12362: sub load_tmp_file {
                   12363:     my $r=shift;
                   12364:     my @studentdata=();
                   12365:     {
1.158     raeburn  12366:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12367:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12368:         if ( open(my $fh,"<$studentfile") ) {
                   12369:             @studentdata=<$fh>;
                   12370:             close($fh);
                   12371:         }
1.31      albertel 12372:     }
1.258     albertel 12373:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12374: }
                   12375: 
1.56      matthew  12376: =pod
                   12377: 
1.648     raeburn  12378: =item * &upfile_record_sep()
1.41      ng       12379: 
                   12380: Separate uploaded file into records
                   12381: returns array of records,
1.258     albertel 12382: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12383: 
                   12384: =cut
1.31      albertel 12385: 
                   12386: sub upfile_record_sep {
1.258     albertel 12387:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12388:     } else {
1.248     albertel 12389: 	my @records;
1.258     albertel 12390: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12391: 	    if ($line=~/^\s*$/) { next; }
                   12392: 	    push(@records,$line);
                   12393: 	}
                   12394: 	return @records;
1.31      albertel 12395:     }
                   12396: }
                   12397: 
1.56      matthew  12398: =pod
                   12399: 
1.648     raeburn  12400: =item * &record_sep($record)
1.41      ng       12401: 
1.258     albertel 12402: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12403: 
                   12404: =cut
                   12405: 
1.263     www      12406: sub takeleft {
                   12407:     my $index=shift;
                   12408:     return substr('0000'.$index,-4,4);
                   12409: }
                   12410: 
1.31      albertel 12411: sub record_sep {
                   12412:     my $record=shift;
                   12413:     my %components=();
1.258     albertel 12414:     if ($env{'form.upfiletype'} eq 'xml') {
                   12415:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12416:         my $i=0;
1.356     albertel 12417:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12418:             $field=~s/^(\"|\')//;
                   12419:             $field=~s/(\"|\')$//;
1.263     www      12420:             $components{&takeleft($i)}=$field;
1.31      albertel 12421:             $i++;
                   12422:         }
1.258     albertel 12423:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12424:         my $i=0;
1.356     albertel 12425:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12426:             $field=~s/^(\"|\')//;
                   12427:             $field=~s/(\"|\')$//;
1.263     www      12428:             $components{&takeleft($i)}=$field;
1.31      albertel 12429:             $i++;
                   12430:         }
                   12431:     } else {
1.561     www      12432:         my $separator=',';
1.480     banghart 12433:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12434:             $separator=';';
1.480     banghart 12435:         }
1.31      albertel 12436:         my $i=0;
1.561     www      12437: # the character we are looking for to indicate the end of a quote or a record 
                   12438:         my $looking_for=$separator;
                   12439: # do not add the characters to the fields
                   12440:         my $ignore=0;
                   12441: # we just encountered a separator (or the beginning of the record)
                   12442:         my $just_found_separator=1;
                   12443: # store the field we are working on here
                   12444:         my $field='';
                   12445: # work our way through all characters in record
                   12446:         foreach my $character ($record=~/(.)/g) {
                   12447:             if ($character eq $looking_for) {
                   12448:                if ($character ne $separator) {
                   12449: # Found the end of a quote, again looking for separator
                   12450:                   $looking_for=$separator;
                   12451:                   $ignore=1;
                   12452:                } else {
                   12453: # Found a separator, store away what we got
                   12454:                   $components{&takeleft($i)}=$field;
                   12455: 	          $i++;
                   12456:                   $just_found_separator=1;
                   12457:                   $ignore=0;
                   12458:                   $field='';
                   12459:                }
                   12460:                next;
                   12461:             }
                   12462: # single or double quotation marks after a separator indicate beginning of a quote
                   12463: # we are now looking for the end of the quote and need to ignore separators
                   12464:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12465:                $looking_for=$character;
                   12466:                next;
                   12467:             }
                   12468: # ignore would be true after we reached the end of a quote
                   12469:             if ($ignore) { next; }
                   12470:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   12471:             $field.=$character;
                   12472:             $just_found_separator=0; 
1.31      albertel 12473:         }
1.561     www      12474: # catch the very last entry, since we never encountered the separator
                   12475:         $components{&takeleft($i)}=$field;
1.31      albertel 12476:     }
                   12477:     return %components;
                   12478: }
                   12479: 
1.144     matthew  12480: ######################################################
                   12481: ######################################################
                   12482: 
1.56      matthew  12483: =pod
                   12484: 
1.648     raeburn  12485: =item * &upfile_select_html()
1.41      ng       12486: 
1.144     matthew  12487: Return HTML code to select a file from the users machine and specify 
                   12488: the file type.
1.41      ng       12489: 
                   12490: =cut
                   12491: 
1.144     matthew  12492: ######################################################
                   12493: ######################################################
1.31      albertel 12494: sub upfile_select_html {
1.144     matthew  12495:     my %Types = (
                   12496:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 12497:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  12498:                  space => &mt('Space separated'),
                   12499:                  tab   => &mt('Tabulator separated'),
                   12500: #                 xml   => &mt('HTML/XML'),
                   12501:                  );
                   12502:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  12503:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  12504:     foreach my $type (sort(keys(%Types))) {
                   12505:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   12506:     }
                   12507:     $Str .= "</select>\n";
                   12508:     return $Str;
1.31      albertel 12509: }
                   12510: 
1.301     albertel 12511: sub get_samples {
                   12512:     my ($records,$toget) = @_;
                   12513:     my @samples=({});
                   12514:     my $got=0;
                   12515:     foreach my $rec (@$records) {
                   12516: 	my %temp = &record_sep($rec);
                   12517: 	if (! grep(/\S/, values(%temp))) { next; }
                   12518: 	if (%temp) {
                   12519: 	    $samples[$got]=\%temp;
                   12520: 	    $got++;
                   12521: 	    if ($got == $toget) { last; }
                   12522: 	}
                   12523:     }
                   12524:     return \@samples;
                   12525: }
                   12526: 
1.144     matthew  12527: ######################################################
                   12528: ######################################################
                   12529: 
1.56      matthew  12530: =pod
                   12531: 
1.648     raeburn  12532: =item * &csv_print_samples($r,$records)
1.41      ng       12533: 
                   12534: Prints a table of sample values from each column uploaded $r is an
                   12535: Apache Request ref, $records is an arrayref from
                   12536: &Apache::loncommon::upfile_record_sep
                   12537: 
                   12538: =cut
                   12539: 
1.144     matthew  12540: ######################################################
                   12541: ######################################################
1.31      albertel 12542: sub csv_print_samples {
                   12543:     my ($r,$records) = @_;
1.662     bisitz   12544:     my $samples = &get_samples($records,5);
1.301     albertel 12545: 
1.594     raeburn  12546:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12547:               &start_data_table_header_row());
1.356     albertel 12548:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12549:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12550:     $r->print(&end_data_table_header_row());
1.301     albertel 12551:     foreach my $hash (@$samples) {
1.594     raeburn  12552: 	$r->print(&start_data_table_row());
1.356     albertel 12553: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12554: 	    $r->print('<td>');
1.356     albertel 12555: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12556: 	    $r->print('</td>');
                   12557: 	}
1.594     raeburn  12558: 	$r->print(&end_data_table_row());
1.31      albertel 12559:     }
1.594     raeburn  12560:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12561: }
                   12562: 
1.144     matthew  12563: ######################################################
                   12564: ######################################################
                   12565: 
1.56      matthew  12566: =pod
                   12567: 
1.648     raeburn  12568: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12569: 
                   12570: Prints a table to create associations between values and table columns.
1.144     matthew  12571: 
1.41      ng       12572: $r is an Apache Request ref,
                   12573: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12574: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12575: 
                   12576: =cut
                   12577: 
1.144     matthew  12578: ######################################################
                   12579: ######################################################
1.31      albertel 12580: sub csv_print_select_table {
                   12581:     my ($r,$records,$d) = @_;
1.301     albertel 12582:     my $i=0;
                   12583:     my $samples = &get_samples($records,1);
1.144     matthew  12584:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12585: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12586:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12587:               '<th>'.&mt('Column').'</th>'.
                   12588:               &end_data_table_header_row()."\n");
1.356     albertel 12589:     foreach my $array_ref (@$d) {
                   12590: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12591: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12592: 
1.875     bisitz   12593: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12594: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12595: 	$r->print('<option value="none"></option>');
1.356     albertel 12596: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12597: 	    $r->print('<option value="'.$sample.'"'.
                   12598:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12599:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12600: 	}
1.594     raeburn  12601: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12602: 	$i++;
                   12603:     }
1.594     raeburn  12604:     $r->print(&end_data_table());
1.31      albertel 12605:     $i--;
                   12606:     return $i;
                   12607: }
1.56      matthew  12608: 
1.144     matthew  12609: ######################################################
                   12610: ######################################################
                   12611: 
1.56      matthew  12612: =pod
1.31      albertel 12613: 
1.648     raeburn  12614: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12615: 
                   12616: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12617: 
                   12618: $r is an Apache Request ref,
                   12619: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12620: $d is an array of 2 element arrays (internal name, displayed name)
                   12621: 
                   12622: =cut
                   12623: 
1.144     matthew  12624: ######################################################
                   12625: ######################################################
1.31      albertel 12626: sub csv_samples_select_table {
                   12627:     my ($r,$records,$d) = @_;
                   12628:     my $i=0;
1.144     matthew  12629:     #
1.662     bisitz   12630:     my $max_samples = 5;
                   12631:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12632:     $r->print(&start_data_table().
                   12633:               &start_data_table_header_row().'<th>'.
                   12634:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12635:               &end_data_table_header_row());
1.301     albertel 12636: 
                   12637:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12638: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12639: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12640: 	foreach my $option (@$d) {
                   12641: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12642: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12643:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12644:                       $display.'</option>');
1.31      albertel 12645: 	}
                   12646: 	$r->print('</select></td><td>');
1.662     bisitz   12647: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12648: 	    if (defined($samples->[$line]{$key})) { 
                   12649: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12650: 	    }
                   12651: 	}
1.594     raeburn  12652: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12653: 	$i++;
                   12654:     }
1.594     raeburn  12655:     $r->print(&end_data_table());
1.31      albertel 12656:     $i--;
                   12657:     return($i);
1.115     matthew  12658: }
                   12659: 
1.144     matthew  12660: ######################################################
                   12661: ######################################################
                   12662: 
1.115     matthew  12663: =pod
                   12664: 
1.648     raeburn  12665: =item * &clean_excel_name($name)
1.115     matthew  12666: 
                   12667: Returns a replacement for $name which does not contain any illegal characters.
                   12668: 
                   12669: =cut
                   12670: 
1.144     matthew  12671: ######################################################
                   12672: ######################################################
1.115     matthew  12673: sub clean_excel_name {
                   12674:     my ($name) = @_;
                   12675:     $name =~ s/[:\*\?\/\\]//g;
                   12676:     if (length($name) > 31) {
                   12677:         $name = substr($name,0,31);
                   12678:     }
                   12679:     return $name;
1.25      albertel 12680: }
1.84      albertel 12681: 
1.85      albertel 12682: =pod
                   12683: 
1.648     raeburn  12684: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12685: 
                   12686: Returns either 1 or undef
                   12687: 
                   12688: 1 if the part is to be hidden, undef if it is to be shown
                   12689: 
                   12690: Arguments are:
                   12691: 
                   12692: $id the id of the part to be checked
                   12693: $symb, optional the symb of the resource to check
                   12694: $udom, optional the domain of the user to check for
                   12695: $uname, optional the username of the user to check for
                   12696: 
                   12697: =cut
1.84      albertel 12698: 
                   12699: sub check_if_partid_hidden {
                   12700:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12701:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12702: 					 $symb,$udom,$uname);
1.141     albertel 12703:     my $truth=1;
                   12704:     #if the string starts with !, then the list is the list to show not hide
                   12705:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12706:     my @hiddenlist=split(/,/,$hiddenparts);
                   12707:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12708: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12709:     }
1.141     albertel 12710:     return !$truth;
1.84      albertel 12711: }
1.127     matthew  12712: 
1.138     matthew  12713: 
                   12714: ############################################################
                   12715: ############################################################
                   12716: 
                   12717: =pod
                   12718: 
1.157     matthew  12719: =back 
                   12720: 
1.138     matthew  12721: =head1 cgi-bin script and graphing routines
                   12722: 
1.157     matthew  12723: =over 4
                   12724: 
1.648     raeburn  12725: =item * &get_cgi_id()
1.138     matthew  12726: 
                   12727: Inputs: none
                   12728: 
                   12729: Returns an id which can be used to pass environment variables
                   12730: to various cgi-bin scripts.  These environment variables will
                   12731: be removed from the users environment after a given time by
                   12732: the routine &Apache::lonnet::transfer_profile_to_env.
                   12733: 
                   12734: =cut
                   12735: 
                   12736: ############################################################
                   12737: ############################################################
1.152     albertel 12738: my $uniq=0;
1.136     matthew  12739: sub get_cgi_id {
1.154     albertel 12740:     $uniq=($uniq+1)%100000;
1.280     albertel 12741:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12742: }
                   12743: 
1.127     matthew  12744: ############################################################
                   12745: ############################################################
                   12746: 
                   12747: =pod
                   12748: 
1.648     raeburn  12749: =item * &DrawBarGraph()
1.127     matthew  12750: 
1.138     matthew  12751: Facilitates the plotting of data in a (stacked) bar graph.
                   12752: Puts plot definition data into the users environment in order for 
                   12753: graph.png to plot it.  Returns an <img> tag for the plot.
                   12754: The bars on the plot are labeled '1','2',...,'n'.
                   12755: 
                   12756: Inputs:
                   12757: 
                   12758: =over 4
                   12759: 
                   12760: =item $Title: string, the title of the plot
                   12761: 
                   12762: =item $xlabel: string, text describing the X-axis of the plot
                   12763: 
                   12764: =item $ylabel: string, text describing the Y-axis of the plot
                   12765: 
                   12766: =item $Max: scalar, the maximum Y value to use in the plot
                   12767: If $Max is < any data point, the graph will not be rendered.
                   12768: 
1.140     matthew  12769: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12770: they are plotted.  If undefined, default values will be used.
                   12771: 
1.178     matthew  12772: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12773: 
1.138     matthew  12774: =item @Values: An array of array references.  Each array reference holds data
                   12775: to be plotted in a stacked bar chart.
                   12776: 
1.239     matthew  12777: =item If the final element of @Values is a hash reference the key/value
                   12778: pairs will be added to the graph definition.
                   12779: 
1.138     matthew  12780: =back
                   12781: 
                   12782: Returns:
                   12783: 
                   12784: An <img> tag which references graph.png and the appropriate identifying
                   12785: information for the plot.
                   12786: 
1.127     matthew  12787: =cut
                   12788: 
                   12789: ############################################################
                   12790: ############################################################
1.134     matthew  12791: sub DrawBarGraph {
1.178     matthew  12792:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12793:     #
                   12794:     if (! defined($colors)) {
                   12795:         $colors = ['#33ff00', 
                   12796:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12797:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12798:                   ]; 
                   12799:     }
1.228     matthew  12800:     my $extra_settings = {};
                   12801:     if (ref($Values[-1]) eq 'HASH') {
                   12802:         $extra_settings = pop(@Values);
                   12803:     }
1.127     matthew  12804:     #
1.136     matthew  12805:     my $identifier = &get_cgi_id();
                   12806:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12807:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12808:         return '';
                   12809:     }
1.225     matthew  12810:     #
                   12811:     my @Labels;
                   12812:     if (defined($labels)) {
                   12813:         @Labels = @$labels;
                   12814:     } else {
                   12815:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12816:             push (@Labels,$i+1);
                   12817:         }
                   12818:     }
                   12819:     #
1.129     matthew  12820:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12821:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12822:     my %ValuesHash;
                   12823:     my $NumSets=1;
                   12824:     foreach my $array (@Values) {
                   12825:         next if (! ref($array));
1.136     matthew  12826:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12827:             join(',',@$array);
1.129     matthew  12828:     }
1.127     matthew  12829:     #
1.136     matthew  12830:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12831:     if ($NumBars < 3) {
                   12832:         $width = 120+$NumBars*32;
1.220     matthew  12833:         $xskip = 1;
1.225     matthew  12834:         $bar_width = 30;
                   12835:     } elsif ($NumBars < 5) {
                   12836:         $width = 120+$NumBars*20;
                   12837:         $xskip = 1;
                   12838:         $bar_width = 20;
1.220     matthew  12839:     } elsif ($NumBars < 10) {
1.136     matthew  12840:         $width = 120+$NumBars*15;
                   12841:         $xskip = 1;
                   12842:         $bar_width = 15;
                   12843:     } elsif ($NumBars <= 25) {
                   12844:         $width = 120+$NumBars*11;
                   12845:         $xskip = 5;
                   12846:         $bar_width = 8;
                   12847:     } elsif ($NumBars <= 50) {
                   12848:         $width = 120+$NumBars*8;
                   12849:         $xskip = 5;
                   12850:         $bar_width = 4;
                   12851:     } else {
                   12852:         $width = 120+$NumBars*8;
                   12853:         $xskip = 5;
                   12854:         $bar_width = 4;
                   12855:     }
                   12856:     #
1.137     matthew  12857:     $Max = 1 if ($Max < 1);
                   12858:     if ( int($Max) < $Max ) {
                   12859:         $Max++;
                   12860:         $Max = int($Max);
                   12861:     }
1.127     matthew  12862:     $Title  = '' if (! defined($Title));
                   12863:     $xlabel = '' if (! defined($xlabel));
                   12864:     $ylabel = '' if (! defined($ylabel));
1.369     www      12865:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12866:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12867:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12868:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12869:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12870:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12871:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12872:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12873:     $ValuesHash{$id.'.height'}   = $height;
                   12874:     $ValuesHash{$id.'.width'}    = $width;
                   12875:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12876:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12877:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12878:     #
1.228     matthew  12879:     # Deal with other parameters
                   12880:     while (my ($key,$value) = each(%$extra_settings)) {
                   12881:         $ValuesHash{$id.'.'.$key} = $value;
                   12882:     }
                   12883:     #
1.646     raeburn  12884:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12885:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12886: }
                   12887: 
                   12888: ############################################################
                   12889: ############################################################
                   12890: 
                   12891: =pod
                   12892: 
1.648     raeburn  12893: =item * &DrawXYGraph()
1.137     matthew  12894: 
1.138     matthew  12895: Facilitates the plotting of data in an XY graph.
                   12896: Puts plot definition data into the users environment in order for 
                   12897: graph.png to plot it.  Returns an <img> tag for the plot.
                   12898: 
                   12899: Inputs:
                   12900: 
                   12901: =over 4
                   12902: 
                   12903: =item $Title: string, the title of the plot
                   12904: 
                   12905: =item $xlabel: string, text describing the X-axis of the plot
                   12906: 
                   12907: =item $ylabel: string, text describing the Y-axis of the plot
                   12908: 
                   12909: =item $Max: scalar, the maximum Y value to use in the plot
                   12910: If $Max is < any data point, the graph will not be rendered.
                   12911: 
                   12912: =item $colors: Array ref containing the hex color codes for the data to be 
                   12913: plotted in.  If undefined, default values will be used.
                   12914: 
                   12915: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12916: 
                   12917: =item $Ydata: Array ref containing Array refs.  
1.185     www      12918: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12919: 
                   12920: =item %Values: hash indicating or overriding any default values which are 
                   12921: passed to graph.png.  
                   12922: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12923: 
                   12924: =back
                   12925: 
                   12926: Returns:
                   12927: 
                   12928: An <img> tag which references graph.png and the appropriate identifying
                   12929: information for the plot.
                   12930: 
1.137     matthew  12931: =cut
                   12932: 
                   12933: ############################################################
                   12934: ############################################################
                   12935: sub DrawXYGraph {
                   12936:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12937:     #
                   12938:     # Create the identifier for the graph
                   12939:     my $identifier = &get_cgi_id();
                   12940:     my $id = 'cgi.'.$identifier;
                   12941:     #
                   12942:     $Title  = '' if (! defined($Title));
                   12943:     $xlabel = '' if (! defined($xlabel));
                   12944:     $ylabel = '' if (! defined($ylabel));
                   12945:     my %ValuesHash = 
                   12946:         (
1.369     www      12947:          $id.'.title'  => &escape($Title),
                   12948:          $id.'.xlabel' => &escape($xlabel),
                   12949:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12950:          $id.'.y_max_value'=> $Max,
                   12951:          $id.'.labels'     => join(',',@$Xlabels),
                   12952:          $id.'.PlotType'   => 'XY',
                   12953:          );
                   12954:     #
                   12955:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12956:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12957:     }
                   12958:     #
                   12959:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12960:         return '';
                   12961:     }
                   12962:     my $NumSets=1;
1.138     matthew  12963:     foreach my $array (@{$Ydata}){
1.137     matthew  12964:         next if (! ref($array));
                   12965:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12966:     }
1.138     matthew  12967:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12968:     #
                   12969:     # Deal with other parameters
                   12970:     while (my ($key,$value) = each(%Values)) {
                   12971:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12972:     }
                   12973:     #
1.646     raeburn  12974:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12975:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12976: }
                   12977: 
                   12978: ############################################################
                   12979: ############################################################
                   12980: 
                   12981: =pod
                   12982: 
1.648     raeburn  12983: =item * &DrawXYYGraph()
1.138     matthew  12984: 
                   12985: Facilitates the plotting of data in an XY graph with two Y axes.
                   12986: Puts plot definition data into the users environment in order for 
                   12987: graph.png to plot it.  Returns an <img> tag for the plot.
                   12988: 
                   12989: Inputs:
                   12990: 
                   12991: =over 4
                   12992: 
                   12993: =item $Title: string, the title of the plot
                   12994: 
                   12995: =item $xlabel: string, text describing the X-axis of the plot
                   12996: 
                   12997: =item $ylabel: string, text describing the Y-axis of the plot
                   12998: 
                   12999: =item $colors: Array ref containing the hex color codes for the data to be 
                   13000: plotted in.  If undefined, default values will be used.
                   13001: 
                   13002: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13003: 
                   13004: =item $Ydata1: The first data set
                   13005: 
                   13006: =item $Min1: The minimum value of the left Y-axis
                   13007: 
                   13008: =item $Max1: The maximum value of the left Y-axis
                   13009: 
                   13010: =item $Ydata2: The second data set
                   13011: 
                   13012: =item $Min2: The minimum value of the right Y-axis
                   13013: 
                   13014: =item $Max2: The maximum value of the left Y-axis
                   13015: 
                   13016: =item %Values: hash indicating or overriding any default values which are 
                   13017: passed to graph.png.  
                   13018: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13019: 
                   13020: =back
                   13021: 
                   13022: Returns:
                   13023: 
                   13024: An <img> tag which references graph.png and the appropriate identifying
                   13025: information for the plot.
1.136     matthew  13026: 
                   13027: =cut
                   13028: 
                   13029: ############################################################
                   13030: ############################################################
1.137     matthew  13031: sub DrawXYYGraph {
                   13032:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13033:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13034:     #
                   13035:     # Create the identifier for the graph
                   13036:     my $identifier = &get_cgi_id();
                   13037:     my $id = 'cgi.'.$identifier;
                   13038:     #
                   13039:     $Title  = '' if (! defined($Title));
                   13040:     $xlabel = '' if (! defined($xlabel));
                   13041:     $ylabel = '' if (! defined($ylabel));
                   13042:     my %ValuesHash = 
                   13043:         (
1.369     www      13044:          $id.'.title'  => &escape($Title),
                   13045:          $id.'.xlabel' => &escape($xlabel),
                   13046:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13047:          $id.'.labels' => join(',',@$Xlabels),
                   13048:          $id.'.PlotType' => 'XY',
                   13049:          $id.'.NumSets' => 2,
1.137     matthew  13050:          $id.'.two_axes' => 1,
                   13051:          $id.'.y1_max_value' => $Max1,
                   13052:          $id.'.y1_min_value' => $Min1,
                   13053:          $id.'.y2_max_value' => $Max2,
                   13054:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13055:          );
                   13056:     #
1.137     matthew  13057:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13058:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13059:     }
                   13060:     #
                   13061:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13062:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13063:         return '';
                   13064:     }
                   13065:     my $NumSets=1;
1.137     matthew  13066:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13067:         next if (! ref($array));
                   13068:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13069:     }
                   13070:     #
                   13071:     # Deal with other parameters
                   13072:     while (my ($key,$value) = each(%Values)) {
                   13073:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13074:     }
                   13075:     #
1.646     raeburn  13076:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13077:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13078: }
                   13079: 
                   13080: ############################################################
                   13081: ############################################################
                   13082: 
                   13083: =pod
                   13084: 
1.157     matthew  13085: =back 
                   13086: 
1.139     matthew  13087: =head1 Statistics helper routines?  
                   13088: 
                   13089: Bad place for them but what the hell.
                   13090: 
1.157     matthew  13091: =over 4
                   13092: 
1.648     raeburn  13093: =item * &chartlink()
1.139     matthew  13094: 
                   13095: Returns a link to the chart for a specific student.  
                   13096: 
                   13097: Inputs:
                   13098: 
                   13099: =over 4
                   13100: 
                   13101: =item $linktext: The text of the link
                   13102: 
                   13103: =item $sname: The students username
                   13104: 
                   13105: =item $sdomain: The students domain
                   13106: 
                   13107: =back
                   13108: 
1.157     matthew  13109: =back
                   13110: 
1.139     matthew  13111: =cut
                   13112: 
                   13113: ############################################################
                   13114: ############################################################
                   13115: sub chartlink {
                   13116:     my ($linktext, $sname, $sdomain) = @_;
                   13117:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13118:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13119:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13120:        '">'.$linktext.'</a>';
1.153     matthew  13121: }
                   13122: 
                   13123: #######################################################
                   13124: #######################################################
                   13125: 
                   13126: =pod
                   13127: 
                   13128: =head1 Course Environment Routines
1.157     matthew  13129: 
                   13130: =over 4
1.153     matthew  13131: 
1.648     raeburn  13132: =item * &restore_course_settings()
1.153     matthew  13133: 
1.648     raeburn  13134: =item * &store_course_settings()
1.153     matthew  13135: 
                   13136: Restores/Store indicated form parameters from the course environment.
                   13137: Will not overwrite existing values of the form parameters.
                   13138: 
                   13139: Inputs: 
                   13140: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13141: 
                   13142: a hash ref describing the data to be stored.  For example:
                   13143:    
                   13144: %Save_Parameters = ('Status' => 'scalar',
                   13145:     'chartoutputmode' => 'scalar',
                   13146:     'chartoutputdata' => 'scalar',
                   13147:     'Section' => 'array',
1.373     raeburn  13148:     'Group' => 'array',
1.153     matthew  13149:     'StudentData' => 'array',
                   13150:     'Maps' => 'array');
                   13151: 
                   13152: Returns: both routines return nothing
                   13153: 
1.631     raeburn  13154: =back
                   13155: 
1.153     matthew  13156: =cut
                   13157: 
                   13158: #######################################################
                   13159: #######################################################
                   13160: sub store_course_settings {
1.496     albertel 13161:     return &store_settings($env{'request.course.id'},@_);
                   13162: }
                   13163: 
                   13164: sub store_settings {
1.153     matthew  13165:     # save to the environment
                   13166:     # appenv the same items, just to be safe
1.300     albertel 13167:     my $udom  = $env{'user.domain'};
                   13168:     my $uname = $env{'user.name'};
1.496     albertel 13169:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13170:     my %SaveHash;
                   13171:     my %AppHash;
                   13172:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13173:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13174:         my $envname = 'environment.'.$basename;
1.258     albertel 13175:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13176:             # Save this value away
                   13177:             if ($type eq 'scalar' &&
1.258     albertel 13178:                 (! exists($env{$envname}) || 
                   13179:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13180:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13181:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13182:             } elsif ($type eq 'array') {
                   13183:                 my $stored_form;
1.258     albertel 13184:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13185:                     $stored_form = join(',',
                   13186:                                         map {
1.369     www      13187:                                             &escape($_);
1.258     albertel 13188:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13189:                 } else {
                   13190:                     $stored_form = 
1.369     www      13191:                         &escape($env{'form.'.$setting});
1.153     matthew  13192:                 }
                   13193:                 # Determine if the array contents are the same.
1.258     albertel 13194:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13195:                     $SaveHash{$basename} = $stored_form;
                   13196:                     $AppHash{$envname}   = $stored_form;
                   13197:                 }
                   13198:             }
                   13199:         }
                   13200:     }
                   13201:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13202:                                           $udom,$uname);
1.153     matthew  13203:     if ($put_result !~ /^(ok|delayed)/) {
                   13204:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13205:                                  'got error:'.$put_result);
                   13206:     }
                   13207:     # Make sure these settings stick around in this session, too
1.646     raeburn  13208:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13209:     return;
                   13210: }
                   13211: 
                   13212: sub restore_course_settings {
1.499     albertel 13213:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13214: }
                   13215: 
                   13216: sub restore_settings {
                   13217:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13218:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13219:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13220:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13221:             '.'.$setting;
1.258     albertel 13222:         if (exists($env{$envname})) {
1.153     matthew  13223:             if ($type eq 'scalar') {
1.258     albertel 13224:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13225:             } elsif ($type eq 'array') {
1.258     albertel 13226:                 $env{'form.'.$setting} = [ 
1.153     matthew  13227:                                            map { 
1.369     www      13228:                                                &unescape($_); 
1.258     albertel 13229:                                            } split(',',$env{$envname})
1.153     matthew  13230:                                            ];
                   13231:             }
                   13232:         }
                   13233:     }
1.127     matthew  13234: }
                   13235: 
1.618     raeburn  13236: #######################################################
                   13237: #######################################################
                   13238: 
                   13239: =pod
                   13240: 
                   13241: =head1 Domain E-mail Routines  
                   13242: 
                   13243: =over 4
                   13244: 
1.648     raeburn  13245: =item * &build_recipient_list()
1.618     raeburn  13246: 
1.1075.2.44  raeburn  13247: Build recipient lists for following types of e-mail:
1.766     raeburn  13248: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44  raeburn  13249: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   13250: module change checking, student/employee ID conflict checks, as
                   13251: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   13252: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  13253: 
                   13254: Inputs:
1.1075.2.44  raeburn  13255: defmail (scalar - email address of default recipient),
                   13256: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   13257: requestsmail, updatesmail, or idconflictsmail).
                   13258: 
1.619     raeburn  13259: defdom (domain for which to retrieve configuration settings),
1.1075.2.44  raeburn  13260: 
                   13261: origmail (scalar - email address of recipient from loncapa.conf,
                   13262: i.e., predates configuration by DC via domainprefs.pm
1.618     raeburn  13263: 
1.655     raeburn  13264: Returns: comma separated list of addresses to which to send e-mail.
                   13265: 
                   13266: =back
1.618     raeburn  13267: 
                   13268: =cut
                   13269: 
                   13270: ############################################################
                   13271: ############################################################
                   13272: sub build_recipient_list {
1.619     raeburn  13273:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13274:     my @recipients;
                   13275:     my $otheremails;
                   13276:     my %domconfig =
                   13277:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13278:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13279:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13280:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13281:                 my @contacts = ('adminemail','supportemail');
                   13282:                 foreach my $item (@contacts) {
                   13283:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13284:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13285:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13286:                             push(@recipients,$addr);
                   13287:                         }
1.619     raeburn  13288:                     }
1.766     raeburn  13289:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13290:                 }
                   13291:             }
1.766     raeburn  13292:         } elsif ($origmail ne '') {
                   13293:             push(@recipients,$origmail);
1.618     raeburn  13294:         }
1.619     raeburn  13295:     } elsif ($origmail ne '') {
                   13296:         push(@recipients,$origmail);
1.618     raeburn  13297:     }
1.688     raeburn  13298:     if (defined($defmail)) {
                   13299:         if ($defmail ne '') {
                   13300:             push(@recipients,$defmail);
                   13301:         }
1.618     raeburn  13302:     }
                   13303:     if ($otheremails) {
1.619     raeburn  13304:         my @others;
                   13305:         if ($otheremails =~ /,/) {
                   13306:             @others = split(/,/,$otheremails);
1.618     raeburn  13307:         } else {
1.619     raeburn  13308:             push(@others,$otheremails);
                   13309:         }
                   13310:         foreach my $addr (@others) {
                   13311:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13312:                 push(@recipients,$addr);
                   13313:             }
1.618     raeburn  13314:         }
                   13315:     }
1.619     raeburn  13316:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13317:     return $recipientlist;
                   13318: }
                   13319: 
1.127     matthew  13320: ############################################################
                   13321: ############################################################
1.154     albertel 13322: 
1.655     raeburn  13323: =pod
                   13324: 
                   13325: =head1 Course Catalog Routines
                   13326: 
                   13327: =over 4
                   13328: 
                   13329: =item * &gather_categories()
                   13330: 
                   13331: Converts category definitions - keys of categories hash stored in  
                   13332: coursecategories in configuration.db on the primary library server in a 
                   13333: domain - to an array.  Also generates javascript and idx hash used to 
                   13334: generate Domain Coordinator interface for editing Course Categories.
                   13335: 
                   13336: Inputs:
1.663     raeburn  13337: 
1.655     raeburn  13338: categories (reference to hash of category definitions).
1.663     raeburn  13339: 
1.655     raeburn  13340: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13341:       categories and subcategories).
1.663     raeburn  13342: 
1.655     raeburn  13343: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13344:       editing Course Categories).
1.663     raeburn  13345: 
1.655     raeburn  13346: jsarray (reference to array of categories used to create Javascript arrays for
                   13347:          Domain Coordinator interface for editing Course Categories).
                   13348: 
                   13349: Returns: nothing
                   13350: 
                   13351: Side effects: populates cats, idx and jsarray. 
                   13352: 
                   13353: =cut
                   13354: 
                   13355: sub gather_categories {
                   13356:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13357:     my %counters;
                   13358:     my $num = 0;
                   13359:     foreach my $item (keys(%{$categories})) {
                   13360:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13361:         if ($container eq '' && $depth == 0) {
                   13362:             $cats->[$depth][$categories->{$item}] = $cat;
                   13363:         } else {
                   13364:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13365:         }
                   13366:         my ($escitem,$tail) = split(/:/,$item,2);
                   13367:         if ($counters{$tail} eq '') {
                   13368:             $counters{$tail} = $num;
                   13369:             $num ++;
                   13370:         }
                   13371:         if (ref($idx) eq 'HASH') {
                   13372:             $idx->{$item} = $counters{$tail};
                   13373:         }
                   13374:         if (ref($jsarray) eq 'ARRAY') {
                   13375:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13376:         }
                   13377:     }
                   13378:     return;
                   13379: }
                   13380: 
                   13381: =pod
                   13382: 
                   13383: =item * &extract_categories()
                   13384: 
                   13385: Used to generate breadcrumb trails for course categories.
                   13386: 
                   13387: Inputs:
1.663     raeburn  13388: 
1.655     raeburn  13389: categories (reference to hash of category definitions).
1.663     raeburn  13390: 
1.655     raeburn  13391: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13392:       categories and subcategories).
1.663     raeburn  13393: 
1.655     raeburn  13394: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  13395: 
1.655     raeburn  13396: allitems (reference to hash - key is category key 
                   13397:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13398: 
1.655     raeburn  13399: idx (reference to hash of counters used in Domain Coordinator interface for
                   13400:       editing Course Categories).
1.663     raeburn  13401: 
1.655     raeburn  13402: jsarray (reference to array of categories used to create Javascript arrays for
                   13403:          Domain Coordinator interface for editing Course Categories).
                   13404: 
1.665     raeburn  13405: subcats (reference to hash of arrays containing all subcategories within each 
                   13406:          category, -recursive)
                   13407: 
1.655     raeburn  13408: Returns: nothing
                   13409: 
                   13410: Side effects: populates trails and allitems hash references.
                   13411: 
                   13412: =cut
                   13413: 
                   13414: sub extract_categories {
1.665     raeburn  13415:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  13416:     if (ref($categories) eq 'HASH') {
                   13417:         &gather_categories($categories,$cats,$idx,$jsarray);
                   13418:         if (ref($cats->[0]) eq 'ARRAY') {
                   13419:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   13420:                 my $name = $cats->[0][$i];
                   13421:                 my $item = &escape($name).'::0';
                   13422:                 my $trailstr;
                   13423:                 if ($name eq 'instcode') {
                   13424:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  13425:                 } elsif ($name eq 'communities') {
                   13426:                     $trailstr = &mt('Communities');
1.655     raeburn  13427:                 } else {
                   13428:                     $trailstr = $name;
                   13429:                 }
                   13430:                 if ($allitems->{$item} eq '') {
                   13431:                     push(@{$trails},$trailstr);
                   13432:                     $allitems->{$item} = scalar(@{$trails})-1;
                   13433:                 }
                   13434:                 my @parents = ($name);
                   13435:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   13436:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   13437:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  13438:                         if (ref($subcats) eq 'HASH') {
                   13439:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   13440:                         }
                   13441:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   13442:                     }
                   13443:                 } else {
                   13444:                     if (ref($subcats) eq 'HASH') {
                   13445:                         $subcats->{$item} = [];
1.655     raeburn  13446:                     }
                   13447:                 }
                   13448:             }
                   13449:         }
                   13450:     }
                   13451:     return;
                   13452: }
                   13453: 
                   13454: =pod
                   13455: 
1.1075.2.56  raeburn  13456: =item * &recurse_categories()
1.655     raeburn  13457: 
                   13458: Recursively used to generate breadcrumb trails for course categories.
                   13459: 
                   13460: Inputs:
1.663     raeburn  13461: 
1.655     raeburn  13462: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13463:       categories and subcategories).
1.663     raeburn  13464: 
1.655     raeburn  13465: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  13466: 
                   13467: category (current course category, for which breadcrumb trail is being generated).
                   13468: 
                   13469: trails (reference to array of breadcrumb trails for each category).
                   13470: 
1.655     raeburn  13471: allitems (reference to hash - key is category key
                   13472:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13473: 
1.655     raeburn  13474: parents (array containing containers directories for current category, 
                   13475:          back to top level). 
                   13476: 
                   13477: Returns: nothing
                   13478: 
                   13479: Side effects: populates trails and allitems hash references
                   13480: 
                   13481: =cut
                   13482: 
                   13483: sub recurse_categories {
1.665     raeburn  13484:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  13485:     my $shallower = $depth - 1;
                   13486:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   13487:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   13488:             my $name = $cats->[$depth]{$category}[$k];
                   13489:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13490:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13491:             if ($allitems->{$item} eq '') {
                   13492:                 push(@{$trails},$trailstr);
                   13493:                 $allitems->{$item} = scalar(@{$trails})-1;
                   13494:             }
                   13495:             my $deeper = $depth+1;
                   13496:             push(@{$parents},$category);
1.665     raeburn  13497:             if (ref($subcats) eq 'HASH') {
                   13498:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   13499:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   13500:                     my $higher;
                   13501:                     if ($j > 0) {
                   13502:                         $higher = &escape($parents->[$j]).':'.
                   13503:                                   &escape($parents->[$j-1]).':'.$j;
                   13504:                     } else {
                   13505:                         $higher = &escape($parents->[$j]).'::'.$j;
                   13506:                     }
                   13507:                     push(@{$subcats->{$higher}},$subcat);
                   13508:                 }
                   13509:             }
                   13510:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   13511:                                 $subcats);
1.655     raeburn  13512:             pop(@{$parents});
                   13513:         }
                   13514:     } else {
                   13515:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13516:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13517:         if ($allitems->{$item} eq '') {
                   13518:             push(@{$trails},$trailstr);
                   13519:             $allitems->{$item} = scalar(@{$trails})-1;
                   13520:         }
                   13521:     }
                   13522:     return;
                   13523: }
                   13524: 
1.663     raeburn  13525: =pod
                   13526: 
1.1075.2.56  raeburn  13527: =item * &assign_categories_table()
1.663     raeburn  13528: 
                   13529: Create a datatable for display of hierarchical categories in a domain,
                   13530: with checkboxes to allow a course to be categorized. 
                   13531: 
                   13532: Inputs:
                   13533: 
                   13534: cathash - reference to hash of categories defined for the domain (from
                   13535:           configuration.db)
                   13536: 
                   13537: currcat - scalar with an & separated list of categories assigned to a course. 
                   13538: 
1.919     raeburn  13539: type    - scalar contains course type (Course or Community).
                   13540: 
1.663     raeburn  13541: Returns: $output (markup to be displayed) 
                   13542: 
                   13543: =cut
                   13544: 
                   13545: sub assign_categories_table {
1.919     raeburn  13546:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13547:     my $output;
                   13548:     if (ref($cathash) eq 'HASH') {
                   13549:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13550:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13551:         $maxdepth = scalar(@cats);
                   13552:         if (@cats > 0) {
                   13553:             my $itemcount = 0;
                   13554:             if (ref($cats[0]) eq 'ARRAY') {
                   13555:                 my @currcategories;
                   13556:                 if ($currcat ne '') {
                   13557:                     @currcategories = split('&',$currcat);
                   13558:                 }
1.919     raeburn  13559:                 my $table;
1.663     raeburn  13560:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13561:                     my $parent = $cats[0][$i];
1.919     raeburn  13562:                     next if ($parent eq 'instcode');
                   13563:                     if ($type eq 'Community') {
                   13564:                         next unless ($parent eq 'communities');
                   13565:                     } else {
                   13566:                         next if ($parent eq 'communities');
                   13567:                     }
1.663     raeburn  13568:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13569:                     my $item = &escape($parent).'::0';
                   13570:                     my $checked = '';
                   13571:                     if (@currcategories > 0) {
                   13572:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13573:                             $checked = ' checked="checked"';
1.663     raeburn  13574:                         }
                   13575:                     }
1.919     raeburn  13576:                     my $parent_title = $parent;
                   13577:                     if ($parent eq 'communities') {
                   13578:                         $parent_title = &mt('Communities');
                   13579:                     }
                   13580:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13581:                               '<input type="checkbox" name="usecategory" value="'.
                   13582:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13583:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13584:                     my $depth = 1;
                   13585:                     push(@path,$parent);
1.919     raeburn  13586:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13587:                     pop(@path);
1.919     raeburn  13588:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13589:                     $itemcount ++;
                   13590:                 }
1.919     raeburn  13591:                 if ($itemcount) {
                   13592:                     $output = &Apache::loncommon::start_data_table().
                   13593:                               $table.
                   13594:                               &Apache::loncommon::end_data_table();
                   13595:                 }
1.663     raeburn  13596:             }
                   13597:         }
                   13598:     }
                   13599:     return $output;
                   13600: }
                   13601: 
                   13602: =pod
                   13603: 
1.1075.2.56  raeburn  13604: =item * &assign_category_rows()
1.663     raeburn  13605: 
                   13606: Create a datatable row for display of nested categories in a domain,
                   13607: with checkboxes to allow a course to be categorized,called recursively.
                   13608: 
                   13609: Inputs:
                   13610: 
                   13611: itemcount - track row number for alternating colors
                   13612: 
                   13613: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13614:       categories and subcategories.
                   13615: 
                   13616: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13617: 
                   13618: parent - parent of current category item
                   13619: 
                   13620: path - Array containing all categories back up through the hierarchy from the
                   13621:        current category to the top level.
                   13622: 
                   13623: currcategories - reference to array of current categories assigned to the course
                   13624: 
                   13625: Returns: $output (markup to be displayed).
                   13626: 
                   13627: =cut
                   13628: 
                   13629: sub assign_category_rows {
                   13630:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13631:     my ($text,$name,$item,$chgstr);
                   13632:     if (ref($cats) eq 'ARRAY') {
                   13633:         my $maxdepth = scalar(@{$cats});
                   13634:         if (ref($cats->[$depth]) eq 'HASH') {
                   13635:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13636:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13637:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45  raeburn  13638:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  13639:                 for (my $j=0; $j<$numchildren; $j++) {
                   13640:                     $name = $cats->[$depth]{$parent}[$j];
                   13641:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13642:                     my $deeper = $depth+1;
                   13643:                     my $checked = '';
                   13644:                     if (ref($currcategories) eq 'ARRAY') {
                   13645:                         if (@{$currcategories} > 0) {
                   13646:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13647:                                 $checked = ' checked="checked"';
1.663     raeburn  13648:                             }
                   13649:                         }
                   13650:                     }
1.664     raeburn  13651:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13652:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13653:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13654:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13655:                              '</td><td>';
1.663     raeburn  13656:                     if (ref($path) eq 'ARRAY') {
                   13657:                         push(@{$path},$name);
                   13658:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13659:                         pop(@{$path});
                   13660:                     }
                   13661:                     $text .= '</td></tr>';
                   13662:                 }
                   13663:                 $text .= '</table></td>';
                   13664:             }
                   13665:         }
                   13666:     }
                   13667:     return $text;
                   13668: }
                   13669: 
1.1075.2.69  raeburn  13670: =pod
                   13671: 
                   13672: =back
                   13673: 
                   13674: =cut
                   13675: 
1.655     raeburn  13676: ############################################################
                   13677: ############################################################
                   13678: 
                   13679: 
1.443     albertel 13680: sub commit_customrole {
1.664     raeburn  13681:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13682:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13683:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13684:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13685:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13686:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13687:                  '</b><br />';
                   13688:     return $output;
                   13689: }
                   13690: 
                   13691: sub commit_standardrole {
1.1075.2.31  raeburn  13692:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  13693:     my ($output,$logmsg,$linefeed);
                   13694:     if ($context eq 'auto') {
                   13695:         $linefeed = "\n";
                   13696:     } else {
                   13697:         $linefeed = "<br />\n";
                   13698:     }  
1.443     albertel 13699:     if ($three eq 'st') {
1.541     raeburn  13700:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31  raeburn  13701:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  13702:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13703:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13704:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13705:         } else {
1.541     raeburn  13706:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13707:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13708:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13709:             if ($context eq 'auto') {
                   13710:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13711:             } else {
                   13712:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13713:                &mt('Add to classlist').': <b>ok</b>';
                   13714:             }
                   13715:             $output .= $linefeed;
1.443     albertel 13716:         }
                   13717:     } else {
                   13718:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13719:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13720:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13721:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13722:         if ($context eq 'auto') {
                   13723:             $output .= $result.$linefeed;
                   13724:         } else {
                   13725:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13726:         }
1.443     albertel 13727:     }
                   13728:     return $output;
                   13729: }
                   13730: 
                   13731: sub commit_studentrole {
1.1075.2.31  raeburn  13732:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   13733:         $credits) = @_;
1.626     raeburn  13734:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13735:     if ($context eq 'auto') {
                   13736:         $linefeed = "\n";
                   13737:     } else {
                   13738:         $linefeed = '<br />'."\n";
                   13739:     }
1.443     albertel 13740:     if (defined($one) && defined($two)) {
                   13741:         my $cid=$one.'_'.$two;
                   13742:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13743:         my $secchange = 0;
                   13744:         my $expire_role_result;
                   13745:         my $modify_section_result;
1.628     raeburn  13746:         if ($oldsec ne '-1') { 
                   13747:             if ($oldsec ne $sec) {
1.443     albertel 13748:                 $secchange = 1;
1.628     raeburn  13749:                 my $now = time;
1.443     albertel 13750:                 my $uurl='/'.$cid;
                   13751:                 $uurl=~s/\_/\//g;
                   13752:                 if ($oldsec) {
                   13753:                     $uurl.='/'.$oldsec;
                   13754:                 }
1.626     raeburn  13755:                 $oldsecurl = $uurl;
1.628     raeburn  13756:                 $expire_role_result = 
1.652     raeburn  13757:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13758:                 if ($env{'request.course.sec'} ne '') { 
                   13759:                     if ($expire_role_result eq 'refused') {
                   13760:                         my @roles = ('st');
                   13761:                         my @statuses = ('previous');
                   13762:                         my @roledoms = ($one);
                   13763:                         my $withsec = 1;
                   13764:                         my %roleshash = 
                   13765:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13766:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13767:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13768:                             my ($oldstart,$oldend) = 
                   13769:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13770:                             if ($oldend > 0 && $oldend <= $now) {
                   13771:                                 $expire_role_result = 'ok';
                   13772:                             }
                   13773:                         }
                   13774:                     }
                   13775:                 }
1.443     albertel 13776:                 $result = $expire_role_result;
                   13777:             }
                   13778:         }
                   13779:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31  raeburn  13780:             $modify_section_result = 
                   13781:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   13782:                                                            undef,undef,undef,$sec,
                   13783:                                                            $end,$start,'','',$cid,
                   13784:                                                            '',$context,$credits);
1.443     albertel 13785:             if ($modify_section_result =~ /^ok/) {
                   13786:                 if ($secchange == 1) {
1.628     raeburn  13787:                     if ($sec eq '') {
                   13788:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13789:                     } else {
                   13790:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13791:                     }
1.443     albertel 13792:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13793:                     if ($sec eq '') {
                   13794:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13795:                     } else {
                   13796:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13797:                     }
1.443     albertel 13798:                 } else {
1.628     raeburn  13799:                     if ($sec eq '') {
                   13800:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13801:                     } else {
                   13802:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13803:                     }
1.443     albertel 13804:                 }
                   13805:             } else {
1.628     raeburn  13806:                 if ($secchange) {       
                   13807:                     $$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;
                   13808:                 } else {
                   13809:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13810:                 }
1.443     albertel 13811:             }
                   13812:             $result = $modify_section_result;
                   13813:         } elsif ($secchange == 1) {
1.628     raeburn  13814:             if ($oldsec eq '') {
1.1075.2.20  raeburn  13815:                 $$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  13816:             } else {
                   13817:                 $$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;
                   13818:             }
1.626     raeburn  13819:             if ($expire_role_result eq 'refused') {
                   13820:                 my $newsecurl = '/'.$cid;
                   13821:                 $newsecurl =~ s/\_/\//g;
                   13822:                 if ($sec ne '') {
                   13823:                     $newsecurl.='/'.$sec;
                   13824:                 }
                   13825:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13826:                     if ($sec eq '') {
                   13827:                         $$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;
                   13828:                     } else {
                   13829:                         $$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;
                   13830:                     }
                   13831:                 }
                   13832:             }
1.443     albertel 13833:         }
                   13834:     } else {
1.626     raeburn  13835:         $$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 13836:         $result = "error: incomplete course id\n";
                   13837:     }
                   13838:     return $result;
                   13839: }
                   13840: 
1.1075.2.25  raeburn  13841: sub show_role_extent {
                   13842:     my ($scope,$context,$role) = @_;
                   13843:     $scope =~ s{^/}{};
                   13844:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   13845:     push(@courseroles,'co');
                   13846:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   13847:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   13848:         $scope =~ s{/}{_};
                   13849:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   13850:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   13851:         my ($audom,$auname) = split(/\//,$scope);
                   13852:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   13853:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   13854:     } else {
                   13855:         $scope =~ s{/$}{};
                   13856:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   13857:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   13858:     }
                   13859: }
                   13860: 
1.443     albertel 13861: ############################################################
                   13862: ############################################################
                   13863: 
1.566     albertel 13864: sub check_clone {
1.578     raeburn  13865:     my ($args,$linefeed) = @_;
1.566     albertel 13866:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13867:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13868:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13869:     my $clonemsg;
                   13870:     my $can_clone = 0;
1.944     raeburn  13871:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13872:     if ($lctype ne 'community') {
                   13873:         $lctype = 'course';
                   13874:     }
1.566     albertel 13875:     if ($clonehome eq 'no_host') {
1.944     raeburn  13876:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13877:             $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'});
                   13878:         } else {
                   13879:             $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'});
                   13880:         }     
1.566     albertel 13881:     } else {
                   13882: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13883:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13884:             if ($clonedesc{'type'} ne 'Community') {
                   13885:                  $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'});
                   13886:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13887:             }
                   13888:         }
1.882     raeburn  13889: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13890:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13891: 	    $can_clone = 1;
                   13892: 	} else {
                   13893: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13894: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13895: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13896:             if (grep(/^\*$/,@cloners)) {
                   13897:                 $can_clone = 1;
                   13898:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13899:                 $can_clone = 1;
                   13900:             } else {
1.908     raeburn  13901:                 my $ccrole = 'cc';
1.944     raeburn  13902:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13903:                     $ccrole = 'co';
                   13904:                 }
1.578     raeburn  13905: 	        my %roleshash =
                   13906: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13907: 					 $args->{'ccdomain'},
1.908     raeburn  13908:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13909: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13910: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13911:                     $can_clone = 1;
                   13912:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13913:                     $can_clone = 1;
                   13914:                 } else {
1.944     raeburn  13915:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13916:                         $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'});
                   13917:                     } else {
                   13918:                         $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'});
                   13919:                     }
1.578     raeburn  13920: 	        }
1.566     albertel 13921: 	    }
1.578     raeburn  13922:         }
1.566     albertel 13923:     }
                   13924:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13925: }
                   13926: 
1.444     albertel 13927: sub construct_course {
1.1075.2.59  raeburn  13928:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444     albertel 13929:     my $outcome;
1.541     raeburn  13930:     my $linefeed =  '<br />'."\n";
                   13931:     if ($context eq 'auto') {
                   13932:         $linefeed = "\n";
                   13933:     }
1.566     albertel 13934: 
                   13935: #
                   13936: # Are we cloning?
                   13937: #
                   13938:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13939:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13940: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13941: 	if ($context ne 'auto') {
1.578     raeburn  13942:             if ($clonemsg ne '') {
                   13943: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13944:             }
1.566     albertel 13945: 	}
                   13946: 	$outcome .= $clonemsg.$linefeed;
                   13947: 
                   13948:         if (!$can_clone) {
                   13949: 	    return (0,$outcome);
                   13950: 	}
                   13951:     }
                   13952: 
1.444     albertel 13953: #
                   13954: # Open course
                   13955: #
                   13956:     my $crstype = lc($args->{'crstype'});
                   13957:     my %cenv=();
                   13958:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13959:                                              $args->{'cdescr'},
                   13960:                                              $args->{'curl'},
                   13961:                                              $args->{'course_home'},
                   13962:                                              $args->{'nonstandard'},
                   13963:                                              $args->{'crscode'},
                   13964:                                              $args->{'ccuname'}.':'.
                   13965:                                              $args->{'ccdomain'},
1.882     raeburn  13966:                                              $args->{'crstype'},
1.885     raeburn  13967:                                              $cnum,$context,$category);
1.444     albertel 13968: 
                   13969:     # Note: The testing routines depend on this being output; see 
                   13970:     # Utils::Course. This needs to at least be output as a comment
                   13971:     # if anyone ever decides to not show this, and Utils::Course::new
                   13972:     # will need to be suitably modified.
1.541     raeburn  13973:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13974:     if ($$courseid =~ /^error:/) {
                   13975:         return (0,$outcome);
                   13976:     }
                   13977: 
1.444     albertel 13978: #
                   13979: # Check if created correctly
                   13980: #
1.479     albertel 13981:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13982:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13983:     if ($crsuhome eq 'no_host') {
                   13984:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13985:         return (0,$outcome);
                   13986:     }
1.541     raeburn  13987:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13988: 
1.444     albertel 13989: #
1.566     albertel 13990: # Do the cloning
                   13991: #   
                   13992:     if ($can_clone && $cloneid) {
                   13993: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13994: 	if ($context ne 'auto') {
                   13995: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13996: 	}
                   13997: 	$outcome .= $clonemsg.$linefeed;
                   13998: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 13999: # Copy all files
1.637     www      14000: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 14001: # Restore URL
1.566     albertel 14002: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 14003: # Restore title
1.566     albertel 14004: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  14005: # Restore creation date, creator and creation context.
                   14006:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   14007:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   14008:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 14009: # Mark as cloned
1.566     albertel 14010: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      14011: # Need to clone grading mode
                   14012:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   14013:         $cenv{'grading'}=$newenv{'grading'};
                   14014: # Do not clone these environment entries
                   14015:         &Apache::lonnet::del('environment',
                   14016:                   ['default_enrollment_start_date',
                   14017:                    'default_enrollment_end_date',
                   14018:                    'question.email',
                   14019:                    'policy.email',
                   14020:                    'comment.email',
                   14021:                    'pch.users.denied',
1.725     raeburn  14022:                    'plc.users.denied',
                   14023:                    'hidefromcat',
1.1075.2.36  raeburn  14024:                    'checkforpriv',
1.1075.2.59  raeburn  14025:                    'categories',
                   14026:                    'internal.uniquecode'],
1.638     www      14027:                    $$crsudom,$$crsunum);
1.1075.2.63  raeburn  14028:         if ($args->{'textbook'}) {
                   14029:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   14030:         }
1.444     albertel 14031:     }
1.566     albertel 14032: 
1.444     albertel 14033: #
                   14034: # Set environment (will override cloned, if existing)
                   14035: #
                   14036:     my @sections = ();
                   14037:     my @xlists = ();
                   14038:     if ($args->{'crstype'}) {
                   14039:         $cenv{'type'}=$args->{'crstype'};
                   14040:     }
                   14041:     if ($args->{'crsid'}) {
                   14042:         $cenv{'courseid'}=$args->{'crsid'};
                   14043:     }
                   14044:     if ($args->{'crscode'}) {
                   14045:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   14046:     }
                   14047:     if ($args->{'crsquota'} ne '') {
                   14048:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   14049:     } else {
                   14050:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   14051:     }
                   14052:     if ($args->{'ccuname'}) {
                   14053:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   14054:                                         ':'.$args->{'ccdomain'};
                   14055:     } else {
                   14056:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   14057:     }
1.1075.2.31  raeburn  14058:     if ($args->{'defaultcredits'}) {
                   14059:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   14060:     }
1.444     albertel 14061:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   14062:     if ($args->{'crssections'}) {
                   14063:         $cenv{'internal.sectionnums'} = '';
                   14064:         if ($args->{'crssections'} =~ m/,/) {
                   14065:             @sections = split/,/,$args->{'crssections'};
                   14066:         } else {
                   14067:             $sections[0] = $args->{'crssections'};
                   14068:         }
                   14069:         if (@sections > 0) {
                   14070:             foreach my $item (@sections) {
                   14071:                 my ($sec,$gp) = split/:/,$item;
                   14072:                 my $class = $args->{'crscode'}.$sec;
                   14073:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   14074:                 $cenv{'internal.sectionnums'} .= $item.',';
                   14075:                 unless ($addcheck eq 'ok') {
                   14076:                     push @badclasses, $class;
                   14077:                 }
                   14078:             }
                   14079:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   14080:         }
                   14081:     }
                   14082: # do not hide course coordinator from staff listing, 
                   14083: # even if privileged
                   14084:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36  raeburn  14085: # add course coordinator's domain to domains to check for privileged users
                   14086: # if different to course domain
                   14087:     if ($$crsudom ne $args->{'ccdomain'}) {
                   14088:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   14089:     }
1.444     albertel 14090: # add crosslistings
                   14091:     if ($args->{'crsxlist'}) {
                   14092:         $cenv{'internal.crosslistings'}='';
                   14093:         if ($args->{'crsxlist'} =~ m/,/) {
                   14094:             @xlists = split/,/,$args->{'crsxlist'};
                   14095:         } else {
                   14096:             $xlists[0] = $args->{'crsxlist'};
                   14097:         }
                   14098:         if (@xlists > 0) {
                   14099:             foreach my $item (@xlists) {
                   14100:                 my ($xl,$gp) = split/:/,$item;
                   14101:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   14102:                 $cenv{'internal.crosslistings'} .= $item.',';
                   14103:                 unless ($addcheck eq 'ok') {
                   14104:                     push @badclasses, $xl;
                   14105:                 }
                   14106:             }
                   14107:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   14108:         }
                   14109:     }
                   14110:     if ($args->{'autoadds'}) {
                   14111:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   14112:     }
                   14113:     if ($args->{'autodrops'}) {
                   14114:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   14115:     }
                   14116: # check for notification of enrollment changes
                   14117:     my @notified = ();
                   14118:     if ($args->{'notify_owner'}) {
                   14119:         if ($args->{'ccuname'} ne '') {
                   14120:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   14121:         }
                   14122:     }
                   14123:     if ($args->{'notify_dc'}) {
                   14124:         if ($uname ne '') { 
1.630     raeburn  14125:             push(@notified,$uname.':'.$udom);
1.444     albertel 14126:         }
                   14127:     }
                   14128:     if (@notified > 0) {
                   14129:         my $notifylist;
                   14130:         if (@notified > 1) {
                   14131:             $notifylist = join(',',@notified);
                   14132:         } else {
                   14133:             $notifylist = $notified[0];
                   14134:         }
                   14135:         $cenv{'internal.notifylist'} = $notifylist;
                   14136:     }
                   14137:     if (@badclasses > 0) {
                   14138:         my %lt=&Apache::lonlocal::texthash(
                   14139:                 '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',
                   14140:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   14141:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   14142:         );
1.541     raeburn  14143:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   14144:                            ' ('.$lt{'adby'}.')';
                   14145:         if ($context eq 'auto') {
                   14146:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 14147:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  14148:             foreach my $item (@badclasses) {
                   14149:                 if ($context eq 'auto') {
                   14150:                     $outcome .= " - $item\n";
                   14151:                 } else {
                   14152:                     $outcome .= "<li>$item</li>\n";
                   14153:                 }
                   14154:             }
                   14155:             if ($context eq 'auto') {
                   14156:                 $outcome .= $linefeed;
                   14157:             } else {
1.566     albertel 14158:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14159:             }
                   14160:         } 
1.444     albertel 14161:     }
                   14162:     if ($args->{'no_end_date'}) {
                   14163:         $args->{'endaccess'} = 0;
                   14164:     }
                   14165:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14166:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14167:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14168:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14169:     if ($args->{'showphotos'}) {
                   14170:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14171:     }
                   14172:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14173:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14174:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14175:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14176:             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'); 
                   14177:             if ($context eq 'auto') {
                   14178:                 $outcome .= $krb_msg;
                   14179:             } else {
1.566     albertel 14180:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14181:             }
                   14182:             $outcome .= $linefeed;
1.444     albertel 14183:         }
                   14184:     }
                   14185:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14186:        if ($args->{'setpolicy'}) {
                   14187:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14188:        }
                   14189:        if ($args->{'setcontent'}) {
                   14190:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14191:        }
                   14192:     }
                   14193:     if ($args->{'reshome'}) {
                   14194: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14195: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14196:     }
                   14197: #
                   14198: # course has keyed access
                   14199: #
                   14200:     if ($args->{'setkeys'}) {
                   14201:        $cenv{'keyaccess'}='yes';
                   14202:     }
                   14203: # if specified, key authority is not course, but user
                   14204: # only active if keyaccess is yes
                   14205:     if ($args->{'keyauth'}) {
1.487     albertel 14206: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14207: 	$user = &LONCAPA::clean_username($user);
                   14208: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14209: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14210: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14211: 	}
                   14212:     }
                   14213: 
1.1075.2.59  raeburn  14214: #
                   14215: #  generate and store uniquecode (available to course requester), if course should have one.
                   14216: #
                   14217:     if ($args->{'uniquecode'}) {
                   14218:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   14219:         if ($code) {
                   14220:             $cenv{'internal.uniquecode'} = $code;
                   14221:             my %crsinfo =
                   14222:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   14223:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   14224:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   14225:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   14226:             }
                   14227:             if (ref($coderef)) {
                   14228:                 $$coderef = $code;
                   14229:             }
                   14230:         }
                   14231:     }
                   14232: 
1.444     albertel 14233:     if ($args->{'disresdis'}) {
                   14234:         $cenv{'pch.roles.denied'}='st';
                   14235:     }
                   14236:     if ($args->{'disablechat'}) {
                   14237:         $cenv{'plc.roles.denied'}='st';
                   14238:     }
                   14239: 
                   14240:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14241:     # course
                   14242:     $cenv{'course.helper.not.run'} = 1;
                   14243:     #
                   14244:     # Use new Randomseed
                   14245:     #
                   14246:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14247:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14248:     #
                   14249:     # The encryption code and receipt prefix for this course
                   14250:     #
                   14251:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14252:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14253:     #
                   14254:     # By default, use standard grading
                   14255:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14256: 
1.541     raeburn  14257:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14258:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14259: #
                   14260: # Open all assignments
                   14261: #
                   14262:     if ($args->{'openall'}) {
                   14263:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14264:        my %storecontent = ($storeunder         => time,
                   14265:                            $storeunder.'.type' => 'date_start');
                   14266:        
                   14267:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14268:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14269:    }
                   14270: #
                   14271: # Set first page
                   14272: #
                   14273:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14274: 	    || ($cloneid)) {
1.445     albertel 14275: 	use LONCAPA::map;
1.444     albertel 14276: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14277: 
                   14278: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14279:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14280: 
1.444     albertel 14281:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14282:         my $title; my $url;
                   14283:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14284: 	    $title=&mt('Syllabus');
1.444     albertel 14285:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14286:         } else {
1.963     raeburn  14287:             $title=&mt('Table of Contents');
1.444     albertel 14288:             $url='/adm/navmaps';
                   14289:         }
1.445     albertel 14290: 
                   14291:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14292: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14293: 
                   14294: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14295:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14296:     }
1.566     albertel 14297: 
                   14298:     return (1,$outcome);
1.444     albertel 14299: }
                   14300: 
1.1075.2.59  raeburn  14301: sub make_unique_code {
                   14302:     my ($cdom,$cnum) = @_;
                   14303:     # get lock on uniquecodes db
                   14304:     my $lockhash = {
                   14305:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   14306:                                                   ':'.$env{'user.domain'},
                   14307:                    };
                   14308:     my $tries = 0;
                   14309:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14310:     my ($code,$error);
                   14311: 
                   14312:     while (($gotlock ne 'ok') && ($tries<3)) {
                   14313:         $tries ++;
                   14314:         sleep 1;
                   14315:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14316:     }
                   14317:     if ($gotlock eq 'ok') {
                   14318:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   14319:         my $gotcode;
                   14320:         my $attempts = 0;
                   14321:         while ((!$gotcode) && ($attempts < 100)) {
                   14322:             $code = &generate_code();
                   14323:             if (!exists($currcodes{$code})) {
                   14324:                 $gotcode = 1;
                   14325:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   14326:                     $error = 'nostore';
                   14327:                 }
                   14328:             }
                   14329:             $attempts ++;
                   14330:         }
                   14331:         my @del_lock = ($cnum."\0".'uniquecodes');
                   14332:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   14333:     } else {
                   14334:         $error = 'nolock';
                   14335:     }
                   14336:     return ($code,$error);
                   14337: }
                   14338: 
                   14339: sub generate_code {
                   14340:     my $code;
                   14341:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   14342:     for (my $i=0; $i<6; $i++) {
                   14343:         my $lettnum = int (rand 2);
                   14344:         my $item = '';
                   14345:         if ($lettnum) {
                   14346:             $item = $letts[int( rand(18) )];
                   14347:         } else {
                   14348:             $item = 1+int( rand(8) );
                   14349:         }
                   14350:         $code .= $item;
                   14351:     }
                   14352:     return $code;
                   14353: }
                   14354: 
1.444     albertel 14355: ############################################################
                   14356: ############################################################
                   14357: 
1.953     droeschl 14358: #SD
                   14359: # only Community and Course, or anything else?
1.378     raeburn  14360: sub course_type {
                   14361:     my ($cid) = @_;
                   14362:     if (!defined($cid)) {
                   14363:         $cid = $env{'request.course.id'};
                   14364:     }
1.404     albertel 14365:     if (defined($env{'course.'.$cid.'.type'})) {
                   14366:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  14367:     } else {
                   14368:         return 'Course';
1.377     raeburn  14369:     }
                   14370: }
1.156     albertel 14371: 
1.406     raeburn  14372: sub group_term {
                   14373:     my $crstype = &course_type();
                   14374:     my %names = (
                   14375:                   'Course' => 'group',
1.865     raeburn  14376:                   'Community' => 'group',
1.406     raeburn  14377:                 );
                   14378:     return $names{$crstype};
                   14379: }
                   14380: 
1.902     raeburn  14381: sub course_types {
1.1075.2.59  raeburn  14382:     my @types = ('official','unofficial','community','textbook');
1.902     raeburn  14383:     my %typename = (
                   14384:                          official   => 'Official course',
                   14385:                          unofficial => 'Unofficial course',
                   14386:                          community  => 'Community',
1.1075.2.59  raeburn  14387:                          textbook   => 'Textbook course',
1.902     raeburn  14388:                    );
                   14389:     return (\@types,\%typename);
                   14390: }
                   14391: 
1.156     albertel 14392: sub icon {
                   14393:     my ($file)=@_;
1.505     albertel 14394:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 14395:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 14396:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 14397:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   14398: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   14399: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14400: 	            $curfext.".gif") {
                   14401: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14402: 		$curfext.".gif";
                   14403: 	}
                   14404:     }
1.249     albertel 14405:     return &lonhttpdurl($iconname);
1.154     albertel 14406: } 
1.84      albertel 14407: 
1.575     albertel 14408: sub lonhttpdurl {
1.692     www      14409: #
                   14410: # Had been used for "small fry" static images on separate port 8080.
                   14411: # Modify here if lightweight http functionality desired again.
                   14412: # Currently eliminated due to increasing firewall issues.
                   14413: #
1.575     albertel 14414:     my ($url)=@_;
1.692     www      14415:     return $url;
1.215     albertel 14416: }
                   14417: 
1.213     albertel 14418: sub connection_aborted {
                   14419:     my ($r)=@_;
                   14420:     $r->print(" ");$r->rflush();
                   14421:     my $c = $r->connection;
                   14422:     return $c->aborted();
                   14423: }
                   14424: 
1.221     foxr     14425: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     14426: #    strings as 'strings'.
                   14427: sub escape_single {
1.221     foxr     14428:     my ($input) = @_;
1.223     albertel 14429:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     14430:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   14431:     return $input;
                   14432: }
1.223     albertel 14433: 
1.222     foxr     14434: #  Same as escape_single, but escape's "'s  This 
                   14435: #  can be used for  "strings"
                   14436: sub escape_double {
                   14437:     my ($input) = @_;
                   14438:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   14439:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   14440:     return $input;
                   14441: }
1.223     albertel 14442:  
1.222     foxr     14443: #   Escapes the last element of a full URL.
                   14444: sub escape_url {
                   14445:     my ($url)   = @_;
1.238     raeburn  14446:     my @urlslices = split(/\//, $url,-1);
1.369     www      14447:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 14448:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     14449: }
1.462     albertel 14450: 
1.820     raeburn  14451: sub compare_arrays {
                   14452:     my ($arrayref1,$arrayref2) = @_;
                   14453:     my (@difference,%count);
                   14454:     @difference = ();
                   14455:     %count = ();
                   14456:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   14457:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   14458:         foreach my $element (keys(%count)) {
                   14459:             if ($count{$element} == 1) {
                   14460:                 push(@difference,$element);
                   14461:             }
                   14462:         }
                   14463:     }
                   14464:     return @difference;
                   14465: }
                   14466: 
1.817     bisitz   14467: # -------------------------------------------------------- Initialize user login
1.462     albertel 14468: sub init_user_environment {
1.463     albertel 14469:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 14470:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   14471: 
                   14472:     my $public=($username eq 'public' && $domain eq 'public');
                   14473: 
                   14474: # See if old ID present, if so, remove
                   14475: 
1.1062    raeburn  14476:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 14477:     my $now=time;
                   14478: 
                   14479:     if ($public) {
                   14480: 	my $max_public=100;
                   14481: 	my $oldest;
                   14482: 	my $oldest_time=0;
                   14483: 	for(my $next=1;$next<=$max_public;$next++) {
                   14484: 	    if (-e $lonids."/publicuser_$next.id") {
                   14485: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   14486: 		if ($mtime<$oldest_time || !$oldest_time) {
                   14487: 		    $oldest_time=$mtime;
                   14488: 		    $oldest=$next;
                   14489: 		}
                   14490: 	    } else {
                   14491: 		$cookie="publicuser_$next";
                   14492: 		last;
                   14493: 	    }
                   14494: 	}
                   14495: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   14496:     } else {
1.463     albertel 14497: 	# if this isn't a robot, kill any existing non-robot sessions
                   14498: 	if (!$args->{'robot'}) {
                   14499: 	    opendir(DIR,$lonids);
                   14500: 	    while ($filename=readdir(DIR)) {
                   14501: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   14502: 		    unlink($lonids.'/'.$filename);
                   14503: 		}
1.462     albertel 14504: 	    }
1.463     albertel 14505: 	    closedir(DIR);
1.462     albertel 14506: 	}
                   14507: # Give them a new cookie
1.463     albertel 14508: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      14509: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 14510: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 14511:     
                   14512: # Initialize roles
                   14513: 
1.1062    raeburn  14514: 	($userroles,$firstaccenv,$timerintenv) = 
                   14515:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 14516:     }
                   14517: # ------------------------------------ Check browser type and MathML capability
                   14518: 
                   14519:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.42  raeburn  14520:         $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
1.462     albertel 14521: 
                   14522: # ------------------------------------------------------------- Get environment
                   14523: 
                   14524:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   14525:     my ($tmp) = keys(%userenv);
                   14526:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   14527:     } else {
                   14528: 	undef(%userenv);
                   14529:     }
                   14530:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   14531: 	$form->{'interface'}=$userenv{'interface'};
                   14532:     }
                   14533:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   14534: 
                   14535: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   14536:     foreach my $option ('interface','localpath','localres') {
                   14537:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 14538:     }
                   14539: # --------------------------------------------------------- Write first profile
                   14540: 
                   14541:     {
                   14542: 	my %initial_env = 
                   14543: 	    ("user.name"          => $username,
                   14544: 	     "user.domain"        => $domain,
                   14545: 	     "user.home"          => $authhost,
                   14546: 	     "browser.type"       => $clientbrowser,
                   14547: 	     "browser.version"    => $clientversion,
                   14548: 	     "browser.mathml"     => $clientmathml,
                   14549: 	     "browser.unicode"    => $clientunicode,
                   14550: 	     "browser.os"         => $clientos,
1.1075.2.42  raeburn  14551:              "browser.mobile"     => $clientmobile,
                   14552:              "browser.info"       => $clientinfo,
1.462     albertel 14553: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   14554: 	     "request.course.fn"  => '',
                   14555: 	     "request.course.uri" => '',
                   14556: 	     "request.course.sec" => '',
                   14557: 	     "request.role"       => 'cm',
                   14558: 	     "request.role.adv"   => $env{'user.adv'},
                   14559: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   14560: 
                   14561:         if ($form->{'localpath'}) {
                   14562: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   14563: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   14564:         }
                   14565: 	
                   14566: 	if ($form->{'interface'}) {
                   14567: 	    $form->{'interface'}=~s/\W//gs;
                   14568: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   14569: 	    $env{'browser.interface'}=$form->{'interface'};
                   14570: 	}
                   14571: 
1.1075.2.54  raeburn  14572:         if ($form->{'iptoken'}) {
                   14573:             my $lonhost = $r->dir_config('lonHostID');
                   14574:             $initial_env{"user.noloadbalance"} = $lonhost;
                   14575:             $env{'user.noloadbalance'} = $lonhost;
                   14576:         }
                   14577: 
1.981     raeburn  14578:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  14579:         my %domdef;
                   14580:         unless ($domain eq 'public') {
                   14581:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   14582:         }
1.980     raeburn  14583: 
1.1075.2.7  raeburn  14584:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  14585:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  14586:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   14587:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  14588:         }
                   14589: 
1.1075.2.59  raeburn  14590:         foreach my $crstype ('official','unofficial','community','textbook') {
1.765     raeburn  14591:             $userenv{'canrequest.'.$crstype} =
                   14592:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  14593:                                                   'reload','requestcourses',
                   14594:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  14595:         }
                   14596: 
1.1075.2.14  raeburn  14597:         $userenv{'canrequest.author'} =
                   14598:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   14599:                                         'reload','requestauthor',
                   14600:                                         \%userenv,\%domdef,\%is_adv);
                   14601:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   14602:                                              $domain,$username);
                   14603:         my $reqstatus = $reqauthor{'author_status'};
                   14604:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   14605:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   14606:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   14607:                                                   $reqauthor{'author'}{'timestamp'};
                   14608:             }
                   14609:         }
                   14610: 
1.462     albertel 14611: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  14612: 
1.462     albertel 14613: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   14614: 		 &GDBM_WRCREAT(),0640)) {
                   14615: 	    &_add_to_env(\%disk_env,\%initial_env);
                   14616: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   14617: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  14618:             if (ref($firstaccenv) eq 'HASH') {
                   14619:                 &_add_to_env(\%disk_env,$firstaccenv);
                   14620:             }
                   14621:             if (ref($timerintenv) eq 'HASH') {
                   14622:                 &_add_to_env(\%disk_env,$timerintenv);
                   14623:             }
1.463     albertel 14624: 	    if (ref($args->{'extra_env'})) {
                   14625: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   14626: 	    }
1.462     albertel 14627: 	    untie(%disk_env);
                   14628: 	} else {
1.705     tempelho 14629: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   14630: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 14631: 	    return 'error: '.$!;
                   14632: 	}
                   14633:     }
                   14634:     $env{'request.role'}='cm';
                   14635:     $env{'request.role.adv'}=$env{'user.adv'};
                   14636:     $env{'browser.type'}=$clientbrowser;
                   14637: 
                   14638:     return $cookie;
                   14639: 
                   14640: }
                   14641: 
                   14642: sub _add_to_env {
                   14643:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14644:     if (ref($env_data) eq 'HASH') {
                   14645:         while (my ($key,$value) = each(%$env_data)) {
                   14646: 	    $idf->{$prefix.$key} = $value;
                   14647: 	    $env{$prefix.$key}   = $value;
                   14648:         }
1.462     albertel 14649:     }
                   14650: }
                   14651: 
1.685     tempelho 14652: # --- Get the symbolic name of a problem and the url
                   14653: sub get_symb {
                   14654:     my ($request,$silent) = @_;
1.726     raeburn  14655:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14656:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14657:     if ($symb eq '') {
                   14658:         if (!$silent) {
1.1071    raeburn  14659:             if (ref($request)) { 
                   14660:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14661:             }
1.685     tempelho 14662:             return ();
                   14663:         }
                   14664:     }
                   14665:     &Apache::lonenc::check_decrypt(\$symb);
                   14666:     return ($symb);
                   14667: }
                   14668: 
                   14669: # --------------------------------------------------------------Get annotation
                   14670: 
                   14671: sub get_annotation {
                   14672:     my ($symb,$enc) = @_;
                   14673: 
                   14674:     my $key = $symb;
                   14675:     if (!$enc) {
                   14676:         $key =
                   14677:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14678:     }
                   14679:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14680:     return $annotation{$key};
                   14681: }
                   14682: 
                   14683: sub clean_symb {
1.731     raeburn  14684:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14685: 
                   14686:     &Apache::lonenc::check_decrypt(\$symb);
                   14687:     my $enc = $env{'request.enc'};
1.731     raeburn  14688:     if ($delete_enc) {
1.730     raeburn  14689:         delete($env{'request.enc'});
                   14690:     }
1.685     tempelho 14691: 
                   14692:     return ($symb,$enc);
                   14693: }
1.462     albertel 14694: 
1.1075.2.69  raeburn  14695: ############################################################
                   14696: ############################################################
                   14697: 
                   14698: =pod
                   14699: 
                   14700: =head1 Routines for building display used to search for courses
                   14701: 
                   14702: 
                   14703: =over 4
                   14704: 
                   14705: =item * &build_filters()
                   14706: 
                   14707: Create markup for a table used to set filters to use when selecting
                   14708: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   14709: and quotacheck.pl
                   14710: 
                   14711: 
                   14712: Inputs:
                   14713: 
                   14714: filterlist - anonymous array of fields to include as potential filters
                   14715: 
                   14716: crstype - course type
                   14717: 
                   14718: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   14719:               to pop-open a course selector (will contain "extra element").
                   14720: 
                   14721: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   14722: 
                   14723: filter - anonymous hash of criteria and their values
                   14724: 
                   14725: action - form action
                   14726: 
                   14727: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   14728: 
                   14729: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
                   14730: 
                   14731: cloneruname - username of owner of new course who wants to clone
                   14732: 
                   14733: clonerudom - domain of owner of new course who wants to clone
                   14734: 
                   14735: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
                   14736: 
                   14737: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   14738: 
                   14739: codedom - domain
                   14740: 
                   14741: formname - value of form element named "form".
                   14742: 
                   14743: fixeddom - domain, if fixed.
                   14744: 
                   14745: prevphase - value to assign to form element named "phase" when going back to the previous screen
                   14746: 
                   14747: cnameelement - name of form element in form on opener page which will receive title of selected course
                   14748: 
                   14749: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   14750: 
                   14751: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   14752: 
                   14753: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   14754: 
                   14755: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   14756: 
                   14757: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   14758: 
                   14759: 
                   14760: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   14761: 
                   14762: 
                   14763: Side Effects: None
                   14764: 
                   14765: =cut
                   14766: 
                   14767: # ---------------------------------------------- search for courses based on last activity etc.
                   14768: 
                   14769: sub build_filters {
                   14770:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   14771:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   14772:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   14773:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   14774:         $clonetext,$clonewarning) = @_;
                   14775:     my ($list,$jscript);
                   14776:     my $onchange = 'javascript:updateFilters(this)';
                   14777:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   14778:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   14779:         $typeselectform,$instcodetitle);
                   14780:     if ($formname eq '') {
                   14781:         $formname = $caller;
                   14782:     }
                   14783:     foreach my $item (@{$filterlist}) {
                   14784:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   14785:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   14786:             if ($item eq 'domainfilter') {
                   14787:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   14788:             } elsif ($item eq 'coursefilter') {
                   14789:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   14790:             } elsif ($item eq 'ownerfilter') {
                   14791:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14792:             } elsif ($item eq 'ownerdomfilter') {
                   14793:                 $filter->{'ownerdomfilter'} =
                   14794:                     &LONCAPA::clean_domain($filter->{$item});
                   14795:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   14796:                                                        'ownerdomfilter',1);
                   14797:             } elsif ($item eq 'personfilter') {
                   14798:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14799:             } elsif ($item eq 'persondomfilter') {
                   14800:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   14801:                                                         'persondomfilter',1);
                   14802:             } else {
                   14803:                 $filter->{$item} =~ s/\W//g;
                   14804:             }
                   14805:             if (!$filter->{$item}) {
                   14806:                 $filter->{$item} = '';
                   14807:             }
                   14808:         }
                   14809:         if ($item eq 'domainfilter') {
                   14810:             my $allow_blank = 1;
                   14811:             if ($formname eq 'portform') {
                   14812:                 $allow_blank=0;
                   14813:             } elsif ($formname eq 'studentform') {
                   14814:                 $allow_blank=0;
                   14815:             }
                   14816:             if ($fixeddom) {
                   14817:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   14818:                                     ' value="'.$codedom.'" />'.
                   14819:                                     &Apache::lonnet::domain($codedom,'description');
                   14820:             } else {
                   14821:                 $domainselectform = &select_dom_form($filter->{$item},
                   14822:                                                      'domainfilter',
                   14823:                                                       $allow_blank,'',$onchange);
                   14824:             }
                   14825:         } else {
                   14826:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   14827:         }
                   14828:     }
                   14829: 
                   14830:     # last course activity filter and selection
                   14831:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   14832: 
                   14833:     # course created filter and selection
                   14834:     if (exists($filter->{'createdfilter'})) {
                   14835:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   14836:     }
                   14837: 
                   14838:     my %lt = &Apache::lonlocal::texthash(
                   14839:                 'cac' => "$crstype Activity",
                   14840:                 'ccr' => "$crstype Created",
                   14841:                 'cde' => "$crstype Title",
                   14842:                 'cdo' => "$crstype Domain",
                   14843:                 'ins' => 'Institutional Code',
                   14844:                 'inc' => 'Institutional Categorization',
                   14845:                 'cow' => "$crstype Owner/Co-owner",
                   14846:                 'cop' => "$crstype Personnel Includes",
                   14847:                 'cog' => 'Type',
                   14848:              );
                   14849: 
                   14850:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   14851:         my $typeval = 'Course';
                   14852:         if ($crstype eq 'Community') {
                   14853:             $typeval = 'Community';
                   14854:         }
                   14855:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   14856:     } else {
                   14857:         $typeselectform =  '<select name="type" size="1"';
                   14858:         if ($onchange) {
                   14859:             $typeselectform .= ' onchange="'.$onchange.'"';
                   14860:         }
                   14861:         $typeselectform .= '>'."\n";
                   14862:         foreach my $posstype ('Course','Community') {
                   14863:             $typeselectform.='<option value="'.$posstype.'"'.
                   14864:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
                   14865:         }
                   14866:         $typeselectform.="</select>";
                   14867:     }
                   14868: 
                   14869:     my ($cloneableonlyform,$cloneabletitle);
                   14870:     if (exists($filter->{'cloneableonly'})) {
                   14871:         my $cloneableon = '';
                   14872:         my $cloneableoff = ' checked="checked"';
                   14873:         if ($filter->{'cloneableonly'}) {
                   14874:             $cloneableon = $cloneableoff;
                   14875:             $cloneableoff = '';
                   14876:         }
                   14877:         $cloneableonlyform = '<span class="LC_nobreak"><label><input type="radio" name="cloneableonly" value="1" '.$cloneableon.'/>&nbsp;'.&mt('Required').'</label>'.('&nbsp;'x3).'<label><input type="radio" name="cloneableonly" value="" '.$cloneableoff.' />&nbsp;'.&mt('No restriction').'</label></span>';
                   14878:         if ($formname eq 'ccrs') {
                   14879:             $cloneabletitle = &mt('Cloneable for').' '.$cloneruname.':'.$clonerudom;
                   14880:         } else {
                   14881:             $cloneabletitle = &mt('Cloneable by you');
                   14882:         }
                   14883:     }
                   14884:     my $officialjs;
                   14885:     if ($crstype eq 'Course') {
                   14886:         if (exists($filter->{'instcodefilter'})) {
                   14887: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   14888: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   14889:             if ($codedom) {
                   14890:                 $officialjs = 1;
                   14891:                 ($instcodeform,$jscript,$$numtitlesref) =
                   14892:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   14893:                                                                   $officialjs,$codetitlesref);
                   14894:                 if ($jscript) {
                   14895:                     $jscript = '<script type="text/javascript">'."\n".
                   14896:                                '// <![CDATA['."\n".
                   14897:                                $jscript."\n".
                   14898:                                '// ]]>'."\n".
                   14899:                                '</script>'."\n";
                   14900:                 }
                   14901:             }
                   14902:             if ($instcodeform eq '') {
                   14903:                 $instcodeform =
                   14904:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   14905:                     $list->{'instcodefilter'}.'" />';
                   14906:                 $instcodetitle = $lt{'ins'};
                   14907:             } else {
                   14908:                 $instcodetitle = $lt{'inc'};
                   14909:             }
                   14910:             if ($fixeddom) {
                   14911:                 $instcodetitle .= '<br />('.$codedom.')';
                   14912:             }
                   14913:         }
                   14914:     }
                   14915:     my $output = qq|
                   14916: <form method="post" name="filterpicker" action="$action">
                   14917: <input type="hidden" name="form" value="$formname" />
                   14918: |;
                   14919:     if ($formname eq 'modifycourse') {
                   14920:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   14921:                    '<input type="hidden" name="prevphase" value="'.
                   14922:                    $prevphase.'" />'."\n";
                   14923:     } elsif ($formname ne 'quotacheck') {
                   14924:         my $name_input;
                   14925:         if ($cnameelement ne '') {
                   14926:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   14927:                           $cnameelement.'" />';
                   14928:         }
                   14929:         $output .= qq|
                   14930: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   14931: <input type="hidden" name="cdomelement" value="$cdomelement" />
                   14932: $name_input
                   14933: $roleelement
                   14934: $multelement
                   14935: $typeelement
                   14936: |;
                   14937:         if ($formname eq 'portform') {
                   14938:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   14939:         }
                   14940:     }
                   14941:     if ($fixeddom) {
                   14942:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   14943:     }
                   14944:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   14945:     if ($sincefilterform) {
                   14946:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   14947:                   .$sincefilterform
                   14948:                   .&Apache::lonhtmlcommon::row_closure();
                   14949:     }
                   14950:     if ($createdfilterform) {
                   14951:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   14952:                   .$createdfilterform
                   14953:                   .&Apache::lonhtmlcommon::row_closure();
                   14954:     }
                   14955:     if ($domainselectform) {
                   14956:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   14957:                   .$domainselectform
                   14958:                   .&Apache::lonhtmlcommon::row_closure();
                   14959:     }
                   14960:     if ($typeselectform) {
                   14961:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   14962:             $output .= $typeselectform;
                   14963:         } else {
                   14964:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   14965:                       .$typeselectform
                   14966:                       .&Apache::lonhtmlcommon::row_closure();
                   14967:         }
                   14968:     }
                   14969:     if ($instcodeform) {
                   14970:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   14971:                   .$instcodeform
                   14972:                   .&Apache::lonhtmlcommon::row_closure();
                   14973:     }
                   14974:     if (exists($filter->{'ownerfilter'})) {
                   14975:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   14976:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   14977:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   14978:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   14979:                    $ownerdomselectform.'</td></tr></table>'.
                   14980:                    &Apache::lonhtmlcommon::row_closure();
                   14981:     }
                   14982:     if (exists($filter->{'personfilter'})) {
                   14983:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   14984:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   14985:                    '<input type="text" name="personfilter" size="20" value="'.
                   14986:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   14987:                    $persondomselectform.'</td></tr></table>'.
                   14988:                    &Apache::lonhtmlcommon::row_closure();
                   14989:     }
                   14990:     if (exists($filter->{'coursefilter'})) {
                   14991:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   14992:                   .'<input type="text" name="coursefilter" size="25" value="'
                   14993:                   .$list->{'coursefilter'}.'" />'
                   14994:                   .&Apache::lonhtmlcommon::row_closure();
                   14995:     }
                   14996:     if ($cloneableonlyform) {
                   14997:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   14998:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   14999:     }
                   15000:     if (exists($filter->{'descriptfilter'})) {
                   15001:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   15002:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   15003:                   .$list->{'descriptfilter'}.'" />'
                   15004:                   .&Apache::lonhtmlcommon::row_closure(1);
                   15005:     }
                   15006:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   15007:                '<input type="hidden" name="updater" value="" />'."\n".
                   15008:                '<input type="submit" name="gosearch" value="'.
                   15009:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   15010:     return $jscript.$clonewarning.$output;
                   15011: }
                   15012: 
                   15013: =pod
                   15014: 
                   15015: =item * &timebased_select_form()
                   15016: 
                   15017: Create markup for a dropdown list used to select a time-based
                   15018: filter e.g., Course Activity, Course Created, when searching for courses
                   15019: or communities
                   15020: 
                   15021: Inputs:
                   15022: 
                   15023: item - name of form element (sincefilter or createdfilter)
                   15024: 
                   15025: filter - anonymous hash of criteria and their values
                   15026: 
                   15027: Returns: HTML for a select box contained a blank, then six time selections,
                   15028:          with value set in incoming form variables currently selected.
                   15029: 
                   15030: Side Effects: None
                   15031: 
                   15032: =cut
                   15033: 
                   15034: sub timebased_select_form {
                   15035:     my ($item,$filter) = @_;
                   15036:     if (ref($filter) eq 'HASH') {
                   15037:         $filter->{$item} =~ s/[^\d-]//g;
                   15038:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   15039:         return &select_form(
                   15040:                             $filter->{$item},
                   15041:                             $item,
                   15042:                             {      '-1' => '',
                   15043:                                 '86400' => &mt('today'),
                   15044:                                '604800' => &mt('last week'),
                   15045:                               '2592000' => &mt('last month'),
                   15046:                               '7776000' => &mt('last three months'),
                   15047:                              '15552000' => &mt('last six months'),
                   15048:                              '31104000' => &mt('last year'),
                   15049:                     'select_form_order' =>
                   15050:                            ['-1','86400','604800','2592000','7776000',
                   15051:                             '15552000','31104000']});
                   15052:     }
                   15053: }
                   15054: 
                   15055: =pod
                   15056: 
                   15057: =item * &js_changer()
                   15058: 
                   15059: Create script tag containing Javascript used to submit course search form
                   15060: when course type or domain is changed, and also to hide 'Searching ...' on
                   15061: page load completion for page showing search result.
                   15062: 
                   15063: Inputs: None
                   15064: 
                   15065: Returns: markup containing updateFilters() and hideSearching() javascript functions.
                   15066: 
                   15067: Side Effects: None
                   15068: 
                   15069: =cut
                   15070: 
                   15071: sub js_changer {
                   15072:     return <<ENDJS;
                   15073: <script type="text/javascript">
                   15074: // <![CDATA[
                   15075: function updateFilters(caller) {
                   15076:     if (typeof(caller) != "undefined") {
                   15077:         document.filterpicker.updater.value = caller.name;
                   15078:     }
                   15079:     document.filterpicker.submit();
                   15080: }
                   15081: 
                   15082: function hideSearching() {
                   15083:     if (document.getElementById('searching')) {
                   15084:         document.getElementById('searching').style.display = 'none';
                   15085:     }
                   15086:     return;
                   15087: }
                   15088: 
                   15089: // ]]>
                   15090: </script>
                   15091: 
                   15092: ENDJS
                   15093: }
                   15094: 
                   15095: =pod
                   15096: 
                   15097: =item * &search_courses()
                   15098: 
                   15099: Process selected filters form course search form and pass to lonnet::courseiddump
                   15100: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   15101: 
                   15102: Inputs:
                   15103: 
                   15104: dom - domain being searched
                   15105: 
                   15106: type - course type ('Course' or 'Community' or '.' if any).
                   15107: 
                   15108: filter - anonymous hash of criteria and their values
                   15109: 
                   15110: numtitles - for institutional codes - number of categories
                   15111: 
                   15112: cloneruname - optional username of new course owner
                   15113: 
                   15114: clonerudom - optional domain of new course owner
                   15115: 
                   15116: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
                   15117:             (used when DC is using course creation form)
                   15118: 
                   15119: codetitles - reference to array of titles of components in institutional codes (official courses).
                   15120: 
                   15121: 
                   15122: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   15123: 
                   15124: 
                   15125: Side Effects: None
                   15126: 
                   15127: =cut
                   15128: 
                   15129: 
                   15130: sub search_courses {
                   15131:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
                   15132:     my (%courses,%showcourses,$cloner);
                   15133:     if (($filter->{'ownerfilter'} ne '') ||
                   15134:         ($filter->{'ownerdomfilter'} ne '')) {
                   15135:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   15136:                                        $filter->{'ownerdomfilter'};
                   15137:     }
                   15138:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   15139:         if (!$filter->{$item}) {
                   15140:             $filter->{$item}='.';
                   15141:         }
                   15142:     }
                   15143:     my $now = time;
                   15144:     my $timefilter =
                   15145:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   15146:     my ($createdbefore,$createdafter);
                   15147:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   15148:         $createdbefore = $now;
                   15149:         $createdafter = $now-$filter->{'createdfilter'};
                   15150:     }
                   15151:     my ($instcodefilter,$regexpok);
                   15152:     if ($numtitles) {
                   15153:         if ($env{'form.official'} eq 'on') {
                   15154:             $instcodefilter =
                   15155:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15156:             $regexpok = 1;
                   15157:         } elsif ($env{'form.official'} eq 'off') {
                   15158:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15159:             unless ($instcodefilter eq '') {
                   15160:                 $regexpok = -1;
                   15161:             }
                   15162:         }
                   15163:     } else {
                   15164:         $instcodefilter = $filter->{'instcodefilter'};
                   15165:     }
                   15166:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   15167:     if ($type eq '') { $type = '.'; }
                   15168: 
                   15169:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   15170:         $cloner = $cloneruname.':'.$clonerudom;
                   15171:     }
                   15172:     %courses = &Apache::lonnet::courseiddump($dom,
                   15173:                                              $filter->{'descriptfilter'},
                   15174:                                              $timefilter,
                   15175:                                              $instcodefilter,
                   15176:                                              $filter->{'combownerfilter'},
                   15177:                                              $filter->{'coursefilter'},
                   15178:                                              undef,undef,$type,$regexpok,undef,undef,
                   15179:                                              undef,undef,$cloner,$env{'form.cc_clone'},
                   15180:                                              $filter->{'cloneableonly'},
                   15181:                                              $createdbefore,$createdafter,undef,
                   15182:                                              $domcloner);
                   15183:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   15184:         my $ccrole;
                   15185:         if ($type eq 'Community') {
                   15186:             $ccrole = 'co';
                   15187:         } else {
                   15188:             $ccrole = 'cc';
                   15189:         }
                   15190:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   15191:                                                      $filter->{'persondomfilter'},
                   15192:                                                      'userroles',undef,
                   15193:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   15194:                                                      $dom);
                   15195:         foreach my $role (keys(%rolehash)) {
                   15196:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   15197:             my $cid = $cdom.'_'.$cnum;
                   15198:             if (exists($courses{$cid})) {
                   15199:                 if (ref($courses{$cid}) eq 'HASH') {
                   15200:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   15201:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                   15202:                             push (@{$courses{$cid}{roles}},$courserole);
                   15203:                         }
                   15204:                     } else {
                   15205:                         $courses{$cid}{roles} = [$courserole];
                   15206:                     }
                   15207:                     $showcourses{$cid} = $courses{$cid};
                   15208:                 }
                   15209:             }
                   15210:         }
                   15211:         %courses = %showcourses;
                   15212:     }
                   15213:     return %courses;
                   15214: }
                   15215: 
                   15216: 
                   15217: =pod
                   15218: 
                   15219: =back
                   15220: 
                   15221: =cut
                   15222: 
                   15223: 
1.990     raeburn  15224: sub build_release_hashes {
                   15225:     my ($checkparms,$checkresponsetypes,$checkcrstypes,$anonsurvey,$randomizetry) = @_;
                   15226:     return unless((ref($checkparms) eq 'HASH') && (ref($checkresponsetypes) eq 'HASH') &&
                   15227:                   (ref($checkcrstypes) eq 'HASH') && (ref($anonsurvey) eq 'HASH') &&
                   15228:                   (ref($randomizetry) eq 'HASH'));
                   15229:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   15230:         my ($item,$name,$value) = split(/:/,$key);
                   15231:         if ($item eq 'parameter') {
                   15232:             if (ref($checkparms->{$name}) eq 'ARRAY') {
                   15233:                 unless(grep(/^\Q$name\E$/,@{$checkparms->{$name}})) {
                   15234:                     push(@{$checkparms->{$name}},$value);
                   15235:                 }
                   15236:             } else {
                   15237:                 push(@{$checkparms->{$name}},$value);
                   15238:             }
                   15239:         } elsif ($item eq 'resourcetag') {
                   15240:             if ($name eq 'responsetype') {
                   15241:                 $checkresponsetypes->{$value} = $Apache::lonnet::needsrelease{$key}
                   15242:             }
                   15243:         } elsif ($item eq 'course') {
                   15244:             if ($name eq 'crstype') {
                   15245:                 $checkcrstypes->{$value} = $Apache::lonnet::needsrelease{$key};
                   15246:             }
                   15247:         }
                   15248:     }
                   15249:     ($anonsurvey->{major},$anonsurvey->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:anonsurvey'});
                   15250:     ($randomizetry->{major},$randomizetry->{minor}) = split(/\./,$Apache::lonnet::needsrelease{'parameter:type:randomizetry'});
                   15251:     return;
                   15252: }
                   15253: 
1.1075.2.11  raeburn  15254: sub update_content_constraints {
                   15255:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15256:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   15257:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   15258:     my %checkresponsetypes;
                   15259:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   15260:         my ($item,$name,$value) = split(/:/,$key);
                   15261:         if ($item eq 'resourcetag') {
                   15262:             if ($name eq 'responsetype') {
                   15263:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   15264:             }
                   15265:         }
                   15266:     }
                   15267:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15268:     if (defined($navmap)) {
                   15269:         my %allresponses;
                   15270:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   15271:             my %responses = $res->responseTypes();
                   15272:             foreach my $key (keys(%responses)) {
                   15273:                 next unless(exists($checkresponsetypes{$key}));
                   15274:                 $allresponses{$key} += $responses{$key};
                   15275:             }
                   15276:         }
                   15277:         foreach my $key (keys(%allresponses)) {
                   15278:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   15279:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   15280:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   15281:             }
                   15282:         }
                   15283:         undef($navmap);
                   15284:     }
                   15285:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   15286:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   15287:     }
                   15288:     return;
                   15289: }
                   15290: 
1.1075.2.27  raeburn  15291: sub allmaps_incourse {
                   15292:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15293:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   15294:         $cid = $env{'request.course.id'};
                   15295:         $cdom = $env{'course.'.$cid.'.domain'};
                   15296:         $cnum = $env{'course.'.$cid.'.num'};
                   15297:         $chome = $env{'course.'.$cid.'.home'};
                   15298:     }
                   15299:     my %allmaps = ();
                   15300:     my $lastchange =
                   15301:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   15302:     if ($lastchange > $env{'request.course.tied'}) {
                   15303:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   15304:         unless ($ferr) {
                   15305:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   15306:         }
                   15307:     }
                   15308:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15309:     if (defined($navmap)) {
                   15310:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   15311:             $allmaps{$res->src()} = 1;
                   15312:         }
                   15313:     }
                   15314:     return \%allmaps;
                   15315: }
                   15316: 
1.1075.2.11  raeburn  15317: sub parse_supplemental_title {
                   15318:     my ($title) = @_;
                   15319: 
                   15320:     my ($foldertitle,$renametitle);
                   15321:     if ($title =~ /&amp;&amp;&amp;/) {
                   15322:         $title = &HTML::Entites::decode($title);
                   15323:     }
                   15324:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   15325:         $renametitle=$4;
                   15326:         my ($time,$uname,$udom) = ($1,$2,$3);
                   15327:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   15328:         my $name =  &plainname($uname,$udom);
                   15329:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   15330:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   15331:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   15332:             $name.': <br />'.$foldertitle;
                   15333:     }
                   15334:     if (wantarray) {
                   15335:         return ($title,$foldertitle,$renametitle);
                   15336:     }
                   15337:     return $title;
                   15338: }
                   15339: 
1.1075.2.43  raeburn  15340: sub recurse_supplemental {
                   15341:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   15342:     if ($suppmap) {
                   15343:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   15344:         if ($fatal) {
                   15345:             $errors ++;
                   15346:         } else {
                   15347:             if ($#LONCAPA::map::resources > 0) {
                   15348:                 foreach my $res (@LONCAPA::map::resources) {
                   15349:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   15350:                     if (($src ne '') && ($status eq 'res')) {
1.1075.2.46  raeburn  15351:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   15352:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43  raeburn  15353:                         } else {
                   15354:                             $numfiles ++;
                   15355:                         }
                   15356:                     }
                   15357:                 }
                   15358:             }
                   15359:         }
                   15360:     }
                   15361:     return ($numfiles,$errors);
                   15362: }
                   15363: 
1.1075.2.18  raeburn  15364: sub symb_to_docspath {
                   15365:     my ($symb) = @_;
                   15366:     return unless ($symb);
                   15367:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   15368:     if ($resurl=~/\.(sequence|page)$/) {
                   15369:         $mapurl=$resurl;
                   15370:     } elsif ($resurl eq 'adm/navmaps') {
                   15371:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   15372:     }
                   15373:     my $mapresobj;
                   15374:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15375:     if (ref($navmap)) {
                   15376:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   15377:     }
                   15378:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   15379:     my $type=$2;
                   15380:     my $path;
                   15381:     if (ref($mapresobj)) {
                   15382:         my $pcslist = $mapresobj->map_hierarchy();
                   15383:         if ($pcslist ne '') {
                   15384:             foreach my $pc (split(/,/,$pcslist)) {
                   15385:                 next if ($pc <= 1);
                   15386:                 my $res = $navmap->getByMapPc($pc);
                   15387:                 if (ref($res)) {
                   15388:                     my $thisurl = $res->src();
                   15389:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   15390:                     my $thistitle = $res->title();
                   15391:                     $path .= '&'.
                   15392:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46  raeburn  15393:                              &escape($thistitle).
1.1075.2.18  raeburn  15394:                              ':'.$res->randompick().
                   15395:                              ':'.$res->randomout().
                   15396:                              ':'.$res->encrypted().
                   15397:                              ':'.$res->randomorder().
                   15398:                              ':'.$res->is_page();
                   15399:                 }
                   15400:             }
                   15401:         }
                   15402:         $path =~ s/^\&//;
                   15403:         my $maptitle = $mapresobj->title();
                   15404:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15405:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15406:         }
                   15407:         $path .= (($path ne '')? '&' : '').
                   15408:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15409:                  &escape($maptitle).
1.1075.2.18  raeburn  15410:                  ':'.$mapresobj->randompick().
                   15411:                  ':'.$mapresobj->randomout().
                   15412:                  ':'.$mapresobj->encrypted().
                   15413:                  ':'.$mapresobj->randomorder().
                   15414:                  ':'.$mapresobj->is_page();
                   15415:     } else {
                   15416:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   15417:         my $ispage = (($type eq 'page')? 1 : '');
                   15418:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15419:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15420:         }
                   15421:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15422:                 &escape($maptitle).':::::'.$ispage;
1.1075.2.18  raeburn  15423:     }
                   15424:     unless ($mapurl eq 'default') {
                   15425:         $path = 'default&'.
1.1075.2.46  raeburn  15426:                 &escape('Main Content').
1.1075.2.18  raeburn  15427:                 ':::::&'.$path;
                   15428:     }
                   15429:     return $path;
                   15430: }
                   15431: 
1.1075.2.14  raeburn  15432: sub captcha_display {
                   15433:     my ($context,$lonhost) = @_;
                   15434:     my ($output,$error);
                   15435:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   15436:     if ($captcha eq 'original') {
                   15437:         $output = &create_captcha();
                   15438:         unless ($output) {
                   15439:             $error = 'captcha';
                   15440:         }
                   15441:     } elsif ($captcha eq 'recaptcha') {
                   15442:         $output = &create_recaptcha($pubkey);
                   15443:         unless ($output) {
                   15444:             $error = 'recaptcha';
                   15445:         }
                   15446:     }
1.1075.2.66  raeburn  15447:     return ($output,$error,$captcha);
1.1075.2.14  raeburn  15448: }
                   15449: 
                   15450: sub captcha_response {
                   15451:     my ($context,$lonhost) = @_;
                   15452:     my ($captcha_chk,$captcha_error);
                   15453:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   15454:     if ($captcha eq 'original') {
                   15455:         ($captcha_chk,$captcha_error) = &check_captcha();
                   15456:     } elsif ($captcha eq 'recaptcha') {
                   15457:         $captcha_chk = &check_recaptcha($privkey);
                   15458:     } else {
                   15459:         $captcha_chk = 1;
                   15460:     }
                   15461:     return ($captcha_chk,$captcha_error);
                   15462: }
                   15463: 
                   15464: sub get_captcha_config {
                   15465:     my ($context,$lonhost) = @_;
                   15466:     my ($captcha,$pubkey,$privkey,$hashtocheck);
                   15467:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   15468:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   15469:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   15470:     if ($context eq 'usercreation') {
                   15471:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   15472:         if (ref($domconfig{$context}) eq 'HASH') {
                   15473:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   15474:             if (ref($hashtocheck) eq 'HASH') {
                   15475:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   15476:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   15477:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   15478:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   15479:                     }
                   15480:                     if ($privkey && $pubkey) {
                   15481:                         $captcha = 'recaptcha';
                   15482:                     } else {
                   15483:                         $captcha = 'original';
                   15484:                     }
                   15485:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   15486:                     $captcha = 'original';
                   15487:                 }
                   15488:             }
                   15489:         } else {
                   15490:             $captcha = 'captcha';
                   15491:         }
                   15492:     } elsif ($context eq 'login') {
                   15493:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   15494:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   15495:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   15496:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   15497:             if ($privkey && $pubkey) {
                   15498:                 $captcha = 'recaptcha';
                   15499:             } else {
                   15500:                 $captcha = 'original';
                   15501:             }
                   15502:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   15503:             $captcha = 'original';
                   15504:         }
                   15505:     }
                   15506:     return ($captcha,$pubkey,$privkey);
                   15507: }
                   15508: 
                   15509: sub create_captcha {
                   15510:     my %captcha_params = &captcha_settings();
                   15511:     my ($output,$maxtries,$tries) = ('',10,0);
                   15512:     while ($tries < $maxtries) {
                   15513:         $tries ++;
                   15514:         my $captcha = Authen::Captcha->new (
                   15515:                                            output_folder => $captcha_params{'output_dir'},
                   15516:                                            data_folder   => $captcha_params{'db_dir'},
                   15517:                                           );
                   15518:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   15519: 
                   15520:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   15521:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   15522:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1075.2.66  raeburn  15523:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   15524:                       '<br />'.
                   15525:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14  raeburn  15526:             last;
                   15527:         }
                   15528:     }
                   15529:     return $output;
                   15530: }
                   15531: 
                   15532: sub captcha_settings {
                   15533:     my %captcha_params = (
                   15534:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   15535:                            www_output_dir => "/captchaspool",
                   15536:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   15537:                            numchars       => '5',
                   15538:                          );
                   15539:     return %captcha_params;
                   15540: }
                   15541: 
                   15542: sub check_captcha {
                   15543:     my ($captcha_chk,$captcha_error);
                   15544:     my $code = $env{'form.code'};
                   15545:     my $md5sum = $env{'form.crypt'};
                   15546:     my %captcha_params = &captcha_settings();
                   15547:     my $captcha = Authen::Captcha->new(
                   15548:                       output_folder => $captcha_params{'output_dir'},
                   15549:                       data_folder   => $captcha_params{'db_dir'},
                   15550:                   );
1.1075.2.26  raeburn  15551:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14  raeburn  15552:     my %captcha_hash = (
                   15553:                         0       => 'Code not checked (file error)',
                   15554:                        -1      => 'Failed: code expired',
                   15555:                        -2      => 'Failed: invalid code (not in database)',
                   15556:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   15557:     );
                   15558:     if ($captcha_chk != 1) {
                   15559:         $captcha_error = $captcha_hash{$captcha_chk}
                   15560:     }
                   15561:     return ($captcha_chk,$captcha_error);
                   15562: }
                   15563: 
                   15564: sub create_recaptcha {
                   15565:     my ($pubkey) = @_;
1.1075.2.51  raeburn  15566:     my $use_ssl;
                   15567:     if ($ENV{'SERVER_PORT'} == 443) {
                   15568:         $use_ssl = 1;
                   15569:     }
1.1075.2.14  raeburn  15570:     my $captcha = Captcha::reCAPTCHA->new;
                   15571:     return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51  raeburn  15572:            $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.14  raeburn  15573:            &mt('If either word is hard to read, [_1] will replace them.',
1.1075.2.39  raeburn  15574:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14  raeburn  15575:            '<br /><br />';
                   15576: }
                   15577: 
                   15578: sub check_recaptcha {
                   15579:     my ($privkey) = @_;
                   15580:     my $captcha_chk;
                   15581:     my $captcha = Captcha::reCAPTCHA->new;
                   15582:     my $captcha_result =
                   15583:         $captcha->check_answer(
                   15584:                                 $privkey,
                   15585:                                 $ENV{'REMOTE_ADDR'},
                   15586:                                 $env{'form.recaptcha_challenge_field'},
                   15587:                                 $env{'form.recaptcha_response_field'},
                   15588:                               );
                   15589:     if ($captcha_result->{is_valid}) {
                   15590:         $captcha_chk = 1;
                   15591:     }
                   15592:     return $captcha_chk;
                   15593: }
                   15594: 
1.1075.2.64  raeburn  15595: sub emailusername_info {
1.1075.2.67  raeburn  15596:     my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1075.2.64  raeburn  15597:     my %titles = &Apache::lonlocal::texthash (
                   15598:                      lastname      => 'Last Name',
                   15599:                      firstname     => 'First Name',
                   15600:                      institution   => 'School/college/university',
                   15601:                      location      => "School's city, state/province, country",
                   15602:                      web           => "School's web address",
                   15603:                      officialemail => 'E-mail address at institution (if different)',
                   15604:                  );
                   15605:     return (\@fields,\%titles);
                   15606: }
                   15607: 
1.1075.2.56  raeburn  15608: sub cleanup_html {
                   15609:     my ($incoming) = @_;
                   15610:     my $outgoing;
                   15611:     if ($incoming ne '') {
                   15612:         $outgoing = $incoming;
                   15613:         $outgoing =~ s/;/&#059;/g;
                   15614:         $outgoing =~ s/\#/&#035;/g;
                   15615:         $outgoing =~ s/\&/&#038;/g;
                   15616:         $outgoing =~ s/</&#060;/g;
                   15617:         $outgoing =~ s/>/&#062;/g;
                   15618:         $outgoing =~ s/\(/&#040/g;
                   15619:         $outgoing =~ s/\)/&#041;/g;
                   15620:         $outgoing =~ s/"/&#034;/g;
                   15621:         $outgoing =~ s/'/&#039;/g;
                   15622:         $outgoing =~ s/\$/&#036;/g;
                   15623:         $outgoing =~ s{/}{&#047;}g;
                   15624:         $outgoing =~ s/=/&#061;/g;
                   15625:         $outgoing =~ s/\\/&#092;/g
                   15626:     }
                   15627:     return $outgoing;
                   15628: }
                   15629: 
1.1075.2.64  raeburn  15630: # Use:
                   15631: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   15632: #
                   15633: ##################################################
                   15634: #          password associated functions         #
                   15635: ##################################################
                   15636: sub des_keys {
                   15637:     # Make a new key for DES encryption.
                   15638:     # Each key has two parts which are returned separately.
                   15639:     # Please note:  Each key must be passed through the &hex function
                   15640:     # before it is output to the web browser.  The hex versions cannot
                   15641:     # be used to decrypt.
                   15642:     my @hexstr=('0','1','2','3','4','5','6','7',
                   15643:                 '8','9','a','b','c','d','e','f');
                   15644:     my $lkey='';
                   15645:     for (0..7) {
                   15646:         $lkey.=$hexstr[rand(15)];
                   15647:     }
                   15648:     my $ukey='';
                   15649:     for (0..7) {
                   15650:         $ukey.=$hexstr[rand(15)];
                   15651:     }
                   15652:     return ($lkey,$ukey);
                   15653: }
                   15654: 
                   15655: sub des_decrypt {
                   15656:     my ($key,$cyphertext) = @_;
                   15657:     my $keybin=pack("H16",$key);
                   15658:     my $cypher;
                   15659:     if ($Crypt::DES::VERSION>=2.03) {
                   15660:         $cypher=new Crypt::DES $keybin;
                   15661:     } else {
                   15662:         $cypher=new DES $keybin;
                   15663:     }
                   15664:     my $plaintext=
                   15665:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
                   15666:     $plaintext.=
                   15667:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
                   15668:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
                   15669:     return $plaintext;
                   15670: }
                   15671: 
1.112     bowersj2 15672: 1;
                   15673: __END__;
1.41      ng       15674: 

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