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

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.80! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.79 2014/06/22 13:31:52 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.1075.2.71  raeburn  1295: 	       .'</span> <span>'
1.1075.2.78  raeburn  1296:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71  raeburn  1297:                .'</span>';
1.732     raeburn  1298:     }
1.763     bisitz   1299:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1300:     return $out;
1.172     www      1301: }
                   1302: 
1.430     albertel 1303: sub general_help {
                   1304:     my $helptopic='Student_Intro';
                   1305:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1306: 	$helptopic='Authoring_Intro';
1.907     raeburn  1307:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1308: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1309:     } elsif ($env{'request.role'}=~/^dc/) {
                   1310:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1311:     }
                   1312:     return $helptopic;
                   1313: }
                   1314: 
                   1315: sub update_help_link {
                   1316:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1317:     my $origurl = $ENV{'REQUEST_URI'};
                   1318:     $origurl=~s|^/~|/priv/|;
                   1319:     my $timestamp = time;
                   1320:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1321:         $$datum = &escape($$datum);
                   1322:     }
                   1323: 
                   1324:     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";
                   1325:     my $output .= <<"ENDOUTPUT";
                   1326: <script type="text/javascript">
1.824     bisitz   1327: // <![CDATA[
1.430     albertel 1328: banner_link = '$banner_link';
1.824     bisitz   1329: // ]]>
1.430     albertel 1330: </script>
                   1331: ENDOUTPUT
                   1332:     return $output;
                   1333: }
                   1334: 
                   1335: # now just updates the help link and generates a blue icon
1.193     raeburn  1336: sub help_open_menu {
1.430     albertel 1337:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1338: 	= @_;    
1.949     droeschl 1339:     $stayOnPage = 1;
1.430     albertel 1340:     my $output;
                   1341:     if ($component_help) {
                   1342: 	if (!$text) {
                   1343: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1344: 				       $width,$height);
                   1345: 	} else {
                   1346: 	    my $help_text;
                   1347: 	    $help_text=&unescape($topic);
                   1348: 	    $output='<table><tr><td>'.
                   1349: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1350: 				 $width,$height).'</td></tr></table>';
                   1351: 	}
                   1352:     }
                   1353:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1354:     return $output.$banner_link;
                   1355: }
                   1356: 
                   1357: sub top_nav_help {
                   1358:     my ($text) = @_;
1.436     albertel 1359:     $text = &mt($text);
1.1075.2.60  raeburn  1360:     my $stay_on_page;
                   1361:     unless ($env{'environment.remote'} eq 'on') {
                   1362:         $stay_on_page = 1;
                   1363:     }
1.1075.2.61  raeburn  1364:     my ($link,$banner_link);
                   1365:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1366:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1367: 	                         : "javascript:helpMenu('open')";
                   1368:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1369:     }
1.201     raeburn  1370:     my $title = &mt('Get help');
1.1075.2.61  raeburn  1371:     if ($link) {
                   1372:         return <<"END";
1.436     albertel 1373: $banner_link
1.1075.2.56  raeburn  1374: <a href="$link" title="$title">$text</a>
1.436     albertel 1375: END
1.1075.2.61  raeburn  1376:     } else {
                   1377:         return '&nbsp;'.$text.'&nbsp;';
                   1378:     }
1.436     albertel 1379: }
                   1380: 
                   1381: sub help_menu_js {
1.1075.2.52  raeburn  1382:     my ($httphost) = @_;
1.949     droeschl 1383:     my $stayOnPage = 1;
1.436     albertel 1384:     my $width = 620;
                   1385:     my $height = 600;
1.430     albertel 1386:     my $helptopic=&general_help();
1.1075.2.52  raeburn  1387:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1388:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1389:     my $start_page =
                   1390:         &Apache::loncommon::start_page('Help Menu', undef,
                   1391: 				       {'frameset'    => 1,
                   1392: 					'js_ready'    => 1,
1.1075.2.52  raeburn  1393:                                         'use_absolute' => $httphost, 
1.331     albertel 1394: 					'add_entries' => {
                   1395: 					    'border' => '0',
1.579     raeburn  1396: 					    'rows'   => "110,*",},});
1.331     albertel 1397:     my $end_page =
                   1398:         &Apache::loncommon::end_page({'frameset' => 1,
                   1399: 				      'js_ready' => 1,});
                   1400: 
1.436     albertel 1401:     my $template .= <<"ENDTEMPLATE";
                   1402: <script type="text/javascript">
1.877     bisitz   1403: // <![CDATA[
1.253     albertel 1404: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1405: var banner_link = '';
1.243     raeburn  1406: function helpMenu(target) {
                   1407:     var caller = this;
                   1408:     if (target == 'open') {
                   1409:         var newWindow = null;
                   1410:         try {
1.262     albertel 1411:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1412:         }
                   1413:         catch(error) {
                   1414:             writeHelp(caller);
                   1415:             return;
                   1416:         }
                   1417:         if (newWindow) {
                   1418:             caller = newWindow;
                   1419:         }
1.193     raeburn  1420:     }
1.243     raeburn  1421:     writeHelp(caller);
                   1422:     return;
                   1423: }
                   1424: function writeHelp(caller) {
1.1075.2.61  raeburn  1425:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1426:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1427:     caller.document.close();
                   1428:     caller.focus();
1.193     raeburn  1429: }
1.877     bisitz   1430: // END LON-CAPA Internal -->
1.253     albertel 1431: // ]]>
1.436     albertel 1432: </script>
1.193     raeburn  1433: ENDTEMPLATE
                   1434:     return $template;
                   1435: }
                   1436: 
1.172     www      1437: sub help_open_bug {
                   1438:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1439:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1440:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1441:     $text = "" if (not defined $text);
                   1442: 	$stayOnPage=1;
1.184     albertel 1443:     $width = 600 if (not defined $width);
                   1444:     $height = 600 if (not defined $height);
1.172     www      1445: 
                   1446:     $topic=~s/\W+/\+/g;
                   1447:     my $link='';
                   1448:     my $template='';
1.379     albertel 1449:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1450: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1451:     if (!$stayOnPage)
                   1452:     {
                   1453: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1454:     }
                   1455:     else
                   1456:     {
                   1457: 	$link = $url;
                   1458:     }
                   1459:     # Add the text
                   1460:     if ($text ne "")
                   1461:     {
                   1462: 	$template .= 
                   1463:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1464:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1465:     }
                   1466: 
                   1467:     # Add the graphic
1.179     matthew  1468:     my $title = &mt('Report a Bug');
1.215     albertel 1469:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1470:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1471:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1472: ENDTEMPLATE
                   1473:     if ($text ne '') { $template.='</td></tr></table>' };
                   1474:     return $template;
                   1475: 
                   1476: }
                   1477: 
                   1478: sub help_open_faq {
                   1479:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1480:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1481:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1482:     $text = "" if (not defined $text);
                   1483: 	$stayOnPage=1;
                   1484:     $width = 350 if (not defined $width);
                   1485:     $height = 400 if (not defined $height);
                   1486: 
                   1487:     $topic=~s/\W+/\+/g;
                   1488:     my $link='';
                   1489:     my $template='';
                   1490:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1491:     if (!$stayOnPage)
                   1492:     {
                   1493: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1494:     }
                   1495:     else
                   1496:     {
                   1497: 	$link = $url;
                   1498:     }
                   1499: 
                   1500:     # Add the text
                   1501:     if ($text ne "")
                   1502:     {
                   1503: 	$template .= 
1.173     www      1504:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1505:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1506:     }
                   1507: 
                   1508:     # Add the graphic
1.179     matthew  1509:     my $title = &mt('View the FAQ');
1.215     albertel 1510:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1511:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1512:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1513: ENDTEMPLATE
                   1514:     if ($text ne '') { $template.='</td></tr></table>' };
                   1515:     return $template;
                   1516: 
1.44      bowersj2 1517: }
1.37      matthew  1518: 
1.180     matthew  1519: ###############################################################
                   1520: ###############################################################
                   1521: 
1.45      matthew  1522: =pod
                   1523: 
1.648     raeburn  1524: =item * &change_content_javascript():
1.256     matthew  1525: 
                   1526: This and the next function allow you to create small sections of an
                   1527: otherwise static HTML page that you can update on the fly with
                   1528: Javascript, even in Netscape 4.
                   1529: 
                   1530: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1531: must be written to the HTML page once. It will prove the Javascript
                   1532: function "change(name, content)". Calling the change function with the
                   1533: name of the section 
                   1534: you want to update, matching the name passed to C<changable_area>, and
                   1535: the new content you want to put in there, will put the content into
                   1536: that area.
                   1537: 
                   1538: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1539: to contain room for the original contents. You need to "make space"
                   1540: for whatever changes you wish to make, and be B<sure> to check your
                   1541: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1542: it's adequate for updating a one-line status display, but little more.
                   1543: This script will set the space to 100% width, so you only need to
                   1544: worry about height in Netscape 4.
                   1545: 
                   1546: Modern browsers are much less limiting, and if you can commit to the
                   1547: user not using Netscape 4, this feature may be used freely with
                   1548: pretty much any HTML.
                   1549: 
                   1550: =cut
                   1551: 
                   1552: sub change_content_javascript {
                   1553:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1554:     if ($env{'browser.type'} eq 'netscape' &&
                   1555: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1556: 	return (<<NETSCAPE4);
                   1557: 	function change(name, content) {
                   1558: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1559: 	    doc.open();
                   1560: 	    doc.write(content);
                   1561: 	    doc.close();
                   1562: 	}
                   1563: NETSCAPE4
                   1564:     } else {
                   1565: 	# Otherwise, we need to use semi-standards-compliant code
                   1566: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1567: 	# is really scary, and every useful browser supports it
                   1568: 	return (<<DOMBASED);
                   1569: 	function change(name, content) {
                   1570: 	    element = document.getElementById(name);
                   1571: 	    element.innerHTML = content;
                   1572: 	}
                   1573: DOMBASED
                   1574:     }
                   1575: }
                   1576: 
                   1577: =pod
                   1578: 
1.648     raeburn  1579: =item * &changable_area($name,$origContent):
1.256     matthew  1580: 
                   1581: This provides a "changable area" that can be modified on the fly via
                   1582: the Javascript code provided in C<change_content_javascript>. $name is
                   1583: the name you will use to reference the area later; do not repeat the
                   1584: same name on a given HTML page more then once. $origContent is what
                   1585: the area will originally contain, which can be left blank.
                   1586: 
                   1587: =cut
                   1588: 
                   1589: sub changable_area {
                   1590:     my ($name, $origContent) = @_;
                   1591: 
1.258     albertel 1592:     if ($env{'browser.type'} eq 'netscape' &&
                   1593: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1594: 	# If this is netscape 4, we need to use the Layer tag
                   1595: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1596:     } else {
                   1597: 	return "<span id='$name'>$origContent</span>";
                   1598:     }
                   1599: }
                   1600: 
                   1601: =pod
                   1602: 
1.648     raeburn  1603: =item * &viewport_geometry_js 
1.590     raeburn  1604: 
                   1605: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1606: 
                   1607: =cut
                   1608: 
                   1609: 
                   1610: sub viewport_geometry_js { 
                   1611:     return <<"GEOMETRY";
                   1612: var Geometry = {};
                   1613: function init_geometry() {
                   1614:     if (Geometry.init) { return };
                   1615:     Geometry.init=1;
                   1616:     if (window.innerHeight) {
                   1617:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1618:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1619:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1620:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1621:     }
                   1622:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1623:         Geometry.getViewportHeight =
                   1624:             function() { return document.documentElement.clientHeight; };
                   1625:         Geometry.getViewportWidth =
                   1626:             function() { return document.documentElement.clientWidth; };
                   1627: 
                   1628:         Geometry.getHorizontalScroll =
                   1629:             function() { return document.documentElement.scrollLeft; };
                   1630:         Geometry.getVerticalScroll =
                   1631:             function() { return document.documentElement.scrollTop; };
                   1632:     }
                   1633:     else if (document.body.clientHeight) {
                   1634:         Geometry.getViewportHeight =
                   1635:             function() { return document.body.clientHeight; };
                   1636:         Geometry.getViewportWidth =
                   1637:             function() { return document.body.clientWidth; };
                   1638:         Geometry.getHorizontalScroll =
                   1639:             function() { return document.body.scrollLeft; };
                   1640:         Geometry.getVerticalScroll =
                   1641:             function() { return document.body.scrollTop; };
                   1642:     }
                   1643: }
                   1644: 
                   1645: GEOMETRY
                   1646: }
                   1647: 
                   1648: =pod
                   1649: 
1.648     raeburn  1650: =item * &viewport_size_js()
1.590     raeburn  1651: 
                   1652: 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. 
                   1653: 
                   1654: =cut
                   1655: 
                   1656: sub viewport_size_js {
                   1657:     my $geometry = &viewport_geometry_js();
                   1658:     return <<"DIMS";
                   1659: 
                   1660: $geometry
                   1661: 
                   1662: function getViewportDims(width,height) {
                   1663:     init_geometry();
                   1664:     width.value = Geometry.getViewportWidth();
                   1665:     height.value = Geometry.getViewportHeight();
                   1666:     return;
                   1667: }
                   1668: 
                   1669: DIMS
                   1670: }
                   1671: 
                   1672: =pod
                   1673: 
1.648     raeburn  1674: =item * &resize_textarea_js()
1.565     albertel 1675: 
                   1676: emits the needed javascript to resize a textarea to be as big as possible
                   1677: 
                   1678: creates a function resize_textrea that takes two IDs first should be
                   1679: the id of the element to resize, second should be the id of a div that
                   1680: surrounds everything that comes after the textarea, this routine needs
                   1681: to be attached to the <body> for the onload and onresize events.
                   1682: 
1.648     raeburn  1683: =back
1.565     albertel 1684: 
                   1685: =cut
                   1686: 
                   1687: sub resize_textarea_js {
1.590     raeburn  1688:     my $geometry = &viewport_geometry_js();
1.565     albertel 1689:     return <<"RESIZE";
                   1690:     <script type="text/javascript">
1.824     bisitz   1691: // <![CDATA[
1.590     raeburn  1692: $geometry
1.565     albertel 1693: 
1.588     albertel 1694: function getX(element) {
                   1695:     var x = 0;
                   1696:     while (element) {
                   1697: 	x += element.offsetLeft;
                   1698: 	element = element.offsetParent;
                   1699:     }
                   1700:     return x;
                   1701: }
                   1702: function getY(element) {
                   1703:     var y = 0;
                   1704:     while (element) {
                   1705: 	y += element.offsetTop;
                   1706: 	element = element.offsetParent;
                   1707:     }
                   1708:     return y;
                   1709: }
                   1710: 
                   1711: 
1.565     albertel 1712: function resize_textarea(textarea_id,bottom_id) {
                   1713:     init_geometry();
                   1714:     var textarea        = document.getElementById(textarea_id);
                   1715:     //alert(textarea);
                   1716: 
1.588     albertel 1717:     var textarea_top    = getY(textarea);
1.565     albertel 1718:     var textarea_height = textarea.offsetHeight;
                   1719:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1720:     var bottom_top      = getY(bottom);
1.565     albertel 1721:     var bottom_height   = bottom.offsetHeight;
                   1722:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1723:     var fudge           = 23;
1.565     albertel 1724:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1725:     if (new_height < 300) {
                   1726: 	new_height = 300;
                   1727:     }
                   1728:     textarea.style.height=new_height+'px';
                   1729: }
1.824     bisitz   1730: // ]]>
1.565     albertel 1731: </script>
                   1732: RESIZE
                   1733: 
                   1734: }
                   1735: 
                   1736: =pod
                   1737: 
1.256     matthew  1738: =head1 Excel and CSV file utility routines
                   1739: 
                   1740: =cut
                   1741: 
                   1742: ###############################################################
                   1743: ###############################################################
                   1744: 
                   1745: =pod
                   1746: 
1.1075.2.56  raeburn  1747: =over 4
                   1748: 
1.648     raeburn  1749: =item * &csv_translate($text) 
1.37      matthew  1750: 
1.185     www      1751: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1752: format.
                   1753: 
                   1754: =cut
                   1755: 
1.180     matthew  1756: ###############################################################
                   1757: ###############################################################
1.37      matthew  1758: sub csv_translate {
                   1759:     my $text = shift;
                   1760:     $text =~ s/\"/\"\"/g;
1.209     albertel 1761:     $text =~ s/\n/ /g;
1.37      matthew  1762:     return $text;
                   1763: }
1.180     matthew  1764: 
                   1765: ###############################################################
                   1766: ###############################################################
                   1767: 
                   1768: =pod
                   1769: 
1.648     raeburn  1770: =item * &define_excel_formats()
1.180     matthew  1771: 
                   1772: Define some commonly used Excel cell formats.
                   1773: 
                   1774: Currently supported formats:
                   1775: 
                   1776: =over 4
                   1777: 
                   1778: =item header
                   1779: 
                   1780: =item bold
                   1781: 
                   1782: =item h1
                   1783: 
                   1784: =item h2
                   1785: 
                   1786: =item h3
                   1787: 
1.256     matthew  1788: =item h4
                   1789: 
                   1790: =item i
                   1791: 
1.180     matthew  1792: =item date
                   1793: 
                   1794: =back
                   1795: 
                   1796: Inputs: $workbook
                   1797: 
                   1798: Returns: $format, a hash reference.
                   1799: 
1.1057    foxr     1800: 
1.180     matthew  1801: =cut
                   1802: 
                   1803: ###############################################################
                   1804: ###############################################################
                   1805: sub define_excel_formats {
                   1806:     my ($workbook) = @_;
                   1807:     my $format;
                   1808:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1809:                                                 bottom    => 1,
                   1810:                                                 align     => 'center');
                   1811:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1812:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1813:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1814:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1815:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1816:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1817:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1818:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1819:     return $format;
                   1820: }
                   1821: 
                   1822: ###############################################################
                   1823: ###############################################################
1.113     bowersj2 1824: 
                   1825: =pod
                   1826: 
1.648     raeburn  1827: =item * &create_workbook()
1.255     matthew  1828: 
                   1829: Create an Excel worksheet.  If it fails, output message on the
                   1830: request object and return undefs.
                   1831: 
                   1832: Inputs: Apache request object
                   1833: 
                   1834: Returns (undef) on failure, 
                   1835:     Excel worksheet object, scalar with filename, and formats 
                   1836:     from &Apache::loncommon::define_excel_formats on success
                   1837: 
                   1838: =cut
                   1839: 
                   1840: ###############################################################
                   1841: ###############################################################
                   1842: sub create_workbook {
                   1843:     my ($r) = @_;
                   1844:         #
                   1845:     # Create the excel spreadsheet
                   1846:     my $filename = '/prtspool/'.
1.258     albertel 1847:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1848:         time.'_'.rand(1000000000).'.xls';
                   1849:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1850:     if (! defined($workbook)) {
                   1851:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1852:         $r->print(
                   1853:             '<p class="LC_error">'
                   1854:            .&mt('Problems occurred in creating the new Excel file.')
                   1855:            .' '.&mt('This error has been logged.')
                   1856:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1857:            .'</p>'
                   1858:         );
1.255     matthew  1859:         return (undef);
                   1860:     }
                   1861:     #
1.1014    foxr     1862:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1863:     #
                   1864:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1865:     return ($workbook,$filename,$format);
                   1866: }
                   1867: 
                   1868: ###############################################################
                   1869: ###############################################################
                   1870: 
                   1871: =pod
                   1872: 
1.648     raeburn  1873: =item * &create_text_file()
1.113     bowersj2 1874: 
1.542     raeburn  1875: Create a file to write to and eventually make available to the user.
1.256     matthew  1876: If file creation fails, outputs an error message on the request object and 
                   1877: return undefs.
1.113     bowersj2 1878: 
1.256     matthew  1879: Inputs: Apache request object, and file suffix
1.113     bowersj2 1880: 
1.256     matthew  1881: Returns (undef) on failure, 
                   1882:     Filehandle and filename on success.
1.113     bowersj2 1883: 
                   1884: =cut
                   1885: 
1.256     matthew  1886: ###############################################################
                   1887: ###############################################################
                   1888: sub create_text_file {
                   1889:     my ($r,$suffix) = @_;
                   1890:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1891:     my $fh;
                   1892:     my $filename = '/prtspool/'.
1.258     albertel 1893:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1894:         time.'_'.rand(1000000000).'.'.$suffix;
                   1895:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1896:     if (! defined($fh)) {
                   1897:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1898:         $r->print(
                   1899:             '<p class="LC_error">'
                   1900:            .&mt('Problems occurred in creating the output file.')
                   1901:            .' '.&mt('This error has been logged.')
                   1902:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1903:            .'</p>'
                   1904:         );
1.113     bowersj2 1905:     }
1.256     matthew  1906:     return ($fh,$filename)
1.113     bowersj2 1907: }
                   1908: 
                   1909: 
1.256     matthew  1910: =pod 
1.113     bowersj2 1911: 
                   1912: =back
                   1913: 
                   1914: =cut
1.37      matthew  1915: 
                   1916: ###############################################################
1.33      matthew  1917: ##        Home server <option> list generating code          ##
                   1918: ###############################################################
1.35      matthew  1919: 
1.169     www      1920: # ------------------------------------------
                   1921: 
                   1922: sub domain_select {
                   1923:     my ($name,$value,$multiple)=@_;
                   1924:     my %domains=map { 
1.514     albertel 1925: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1926:     } &Apache::lonnet::all_domains();
1.169     www      1927:     if ($multiple) {
                   1928: 	$domains{''}=&mt('Any domain');
1.550     albertel 1929: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1930: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1931:     } else {
1.550     albertel 1932: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1933: 	return &select_form($name,$value,\%domains);
1.169     www      1934:     }
                   1935: }
                   1936: 
1.282     albertel 1937: #-------------------------------------------
                   1938: 
                   1939: =pod
                   1940: 
1.519     raeburn  1941: =head1 Routines for form select boxes
                   1942: 
                   1943: =over 4
                   1944: 
1.648     raeburn  1945: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1946: 
                   1947: Returns a string containing a <select> element int multiple mode
                   1948: 
                   1949: 
                   1950: Args:
                   1951:   $name - name of the <select> element
1.506     raeburn  1952:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1953:   $size - number of rows long the select element is
1.283     albertel 1954:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1955:           (shown text should already have been &mt())
1.506     raeburn  1956:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1957: 
1.282     albertel 1958: =cut
                   1959: 
                   1960: #-------------------------------------------
1.169     www      1961: sub multiple_select_form {
1.284     albertel 1962:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1963:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1964:     my $output='';
1.191     matthew  1965:     if (! defined($size)) {
                   1966:         $size = 4;
1.283     albertel 1967:         if (scalar(keys(%$hash))<4) {
                   1968:             $size = scalar(keys(%$hash));
1.191     matthew  1969:         }
                   1970:     }
1.734     bisitz   1971:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1972:     my @order;
1.506     raeburn  1973:     if (ref($order) eq 'ARRAY')  {
                   1974:         @order = @{$order};
                   1975:     } else {
                   1976:         @order = sort(keys(%$hash));
1.501     banghart 1977:     }
                   1978:     if (exists($$hash{'select_form_order'})) {
                   1979:         @order = @{$$hash{'select_form_order'}};
                   1980:     }
                   1981:         
1.284     albertel 1982:     foreach my $key (@order) {
1.356     albertel 1983:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1984:         $output.='selected="selected" ' if ($selected{$key});
                   1985:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1986:     }
                   1987:     $output.="</select>\n";
                   1988:     return $output;
                   1989: }
                   1990: 
1.88      www      1991: #-------------------------------------------
                   1992: 
                   1993: =pod
                   1994: 
1.970     raeburn  1995: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1996: 
                   1997: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1998: allow a user to select options from a ref to a hash containing:
                   1999: option_name => displayed text. An optional $onchange can include
                   2000: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   2001: 
1.88      www      2002: See lonrights.pm for an example invocation and use.
                   2003: 
                   2004: =cut
                   2005: 
                   2006: #-------------------------------------------
                   2007: sub select_form {
1.970     raeburn  2008:     my ($def,$name,$hashref,$onchange) = @_;
                   2009:     return unless (ref($hashref) eq 'HASH');
                   2010:     if ($onchange) {
                   2011:         $onchange = ' onchange="'.$onchange.'"';
                   2012:     }
                   2013:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 2014:     my @keys;
1.970     raeburn  2015:     if (exists($hashref->{'select_form_order'})) {
                   2016: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2017:     } else {
1.970     raeburn  2018: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2019:     }
1.356     albertel 2020:     foreach my $key (@keys) {
                   2021:         $selectform.=
                   2022: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2023:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2024:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2025:     }
                   2026:     $selectform.="</select>";
                   2027:     return $selectform;
                   2028: }
                   2029: 
1.475     www      2030: # For display filters
                   2031: 
                   2032: sub display_filter {
1.1074    raeburn  2033:     my ($context) = @_;
1.475     www      2034:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2035:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2036:     my $phraseinput = 'hidden';
                   2037:     my $includeinput = 'hidden';
                   2038:     my ($checked,$includetypestext);
                   2039:     if ($env{'form.displayfilter'} eq 'containing') {
                   2040:         $phraseinput = 'text'; 
                   2041:         if ($context eq 'parmslog') {
                   2042:             $includeinput = 'checkbox';
                   2043:             if ($env{'form.includetypes'}) {
                   2044:                 $checked = ' checked="checked"';
                   2045:             }
                   2046:             $includetypestext = &mt('Include parameter types');
                   2047:         }
                   2048:     } else {
                   2049:         $includetypestext = '&nbsp;';
                   2050:     }
                   2051:     my ($additional,$secondid,$thirdid);
                   2052:     if ($context eq 'parmslog') {
                   2053:         $additional = 
                   2054:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2055:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2056:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2057:             '</label>';
                   2058:         $secondid = 'includetypes';
                   2059:         $thirdid = 'includetypestext';
                   2060:     }
                   2061:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2062:                                                     '$secondid','$thirdid')";
                   2063:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2064: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2065: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2066: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2067:            &mt('Filter: [_1]',
1.477     www      2068: 	   &select_form($env{'form.displayfilter'},
                   2069: 			'displayfilter',
1.970     raeburn  2070: 			{'currentfolder' => 'Current folder/page',
1.477     www      2071: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2072: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2073: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2074:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2075:                          '" />'.$additional;
                   2076: }
                   2077: 
                   2078: sub display_filter_js {
                   2079:     my $includetext = &mt('Include parameter types');
                   2080:     return <<"ENDJS";
                   2081:   
                   2082: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2083:     var firstType = 'hidden';
                   2084:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2085:         firstType = 'text';
                   2086:     }
                   2087:     firstObject = document.getElementById(firstid);
                   2088:     if (typeof(firstObject) == 'object') {
                   2089:         if (firstObject.type != firstType) {
                   2090:             changeInputType(firstObject,firstType);
                   2091:         }
                   2092:     }
                   2093:     if (context == 'parmslog') {
                   2094:         var secondType = 'hidden';
                   2095:         if (firstType == 'text') {
                   2096:             secondType = 'checkbox';
                   2097:         }
                   2098:         secondObject = document.getElementById(secondid);  
                   2099:         if (typeof(secondObject) == 'object') {
                   2100:             if (secondObject.type != secondType) {
                   2101:                 changeInputType(secondObject,secondType);
                   2102:             }
                   2103:         }
                   2104:         var textItem = document.getElementById(thirdid);
                   2105:         var currtext = textItem.innerHTML;
                   2106:         var newtext;
                   2107:         if (firstType == 'text') {
                   2108:             newtext = '$includetext';
                   2109:         } else {
                   2110:             newtext = '&nbsp;';
                   2111:         }
                   2112:         if (currtext != newtext) {
                   2113:             textItem.innerHTML = newtext;
                   2114:         }
                   2115:     }
                   2116:     return;
                   2117: }
                   2118: 
                   2119: function changeInputType(oldObject,newType) {
                   2120:     var newObject = document.createElement('input');
                   2121:     newObject.type = newType;
                   2122:     if (oldObject.size) {
                   2123:         newObject.size = oldObject.size;
                   2124:     }
                   2125:     if (oldObject.value) {
                   2126:         newObject.value = oldObject.value;
                   2127:     }
                   2128:     if (oldObject.name) {
                   2129:         newObject.name = oldObject.name;
                   2130:     }
                   2131:     if (oldObject.id) {
                   2132:         newObject.id = oldObject.id;
                   2133:     }
                   2134:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2135:     return;
                   2136: }
                   2137: 
                   2138: ENDJS
1.475     www      2139: }
                   2140: 
1.167     www      2141: sub gradeleveldescription {
                   2142:     my $gradelevel=shift;
                   2143:     my %gradelevels=(0 => 'Not specified',
                   2144: 		     1 => 'Grade 1',
                   2145: 		     2 => 'Grade 2',
                   2146: 		     3 => 'Grade 3',
                   2147: 		     4 => 'Grade 4',
                   2148: 		     5 => 'Grade 5',
                   2149: 		     6 => 'Grade 6',
                   2150: 		     7 => 'Grade 7',
                   2151: 		     8 => 'Grade 8',
                   2152: 		     9 => 'Grade 9',
                   2153: 		     10 => 'Grade 10',
                   2154: 		     11 => 'Grade 11',
                   2155: 		     12 => 'Grade 12',
                   2156: 		     13 => 'Grade 13',
                   2157: 		     14 => '100 Level',
                   2158: 		     15 => '200 Level',
                   2159: 		     16 => '300 Level',
                   2160: 		     17 => '400 Level',
                   2161: 		     18 => 'Graduate Level');
                   2162:     return &mt($gradelevels{$gradelevel});
                   2163: }
                   2164: 
1.163     www      2165: sub select_level_form {
                   2166:     my ($deflevel,$name)=@_;
                   2167:     unless ($deflevel) { $deflevel=0; }
1.167     www      2168:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2169:     for (my $i=0; $i<=18; $i++) {
                   2170:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2171:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2172:                 ">".&gradeleveldescription($i)."</option>\n";
                   2173:     }
                   2174:     $selectform.="</select>";
                   2175:     return $selectform;
1.163     www      2176: }
1.167     www      2177: 
1.35      matthew  2178: #-------------------------------------------
                   2179: 
1.45      matthew  2180: =pod
                   2181: 
1.1075.2.42  raeburn  2182: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2183: 
                   2184: Returns a string containing a <select name='$name' size='1'> form to 
                   2185: allow a user to select the domain to preform an operation in.  
                   2186: See loncreateuser.pm for an example invocation and use.
                   2187: 
1.90      www      2188: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2189: selected");
                   2190: 
1.743     raeburn  2191: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2192: 
1.910     raeburn  2193: 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.
                   2194: 
1.1075.2.36  raeburn  2195: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2196: 
                   2197: The optional $excdoms is a reference to an array of domains which will be excluded from the available options. 
1.563     raeburn  2198: 
1.35      matthew  2199: =cut
                   2200: 
                   2201: #-------------------------------------------
1.34      matthew  2202: sub select_dom_form {
1.1075.2.36  raeburn  2203:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2204:     if ($onchange) {
1.874     raeburn  2205:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2206:     }
1.1075.2.36  raeburn  2207:     my (@domains,%exclude);
1.910     raeburn  2208:     if (ref($incdoms) eq 'ARRAY') {
                   2209:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2210:     } else {
                   2211:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2212:     }
1.90      www      2213:     if ($includeempty) { @domains=('',@domains); }
1.1075.2.36  raeburn  2214:     if (ref($excdoms) eq 'ARRAY') {
                   2215:         map { $exclude{$_} = 1; } @{$excdoms};
                   2216:     }
1.743     raeburn  2217:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2218:     foreach my $dom (@domains) {
1.1075.2.36  raeburn  2219:         next if ($exclude{$dom});
1.356     albertel 2220:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2221:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2222:         if ($showdomdesc) {
                   2223:             if ($dom ne '') {
                   2224:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2225:                 if ($domdesc ne '') {
                   2226:                     $selectdomain .= ' ('.$domdesc.')';
                   2227:                 }
                   2228:             } 
                   2229:         }
                   2230:         $selectdomain .= "</option>\n";
1.34      matthew  2231:     }
                   2232:     $selectdomain.="</select>";
                   2233:     return $selectdomain;
                   2234: }
                   2235: 
1.35      matthew  2236: #-------------------------------------------
                   2237: 
1.45      matthew  2238: =pod
                   2239: 
1.648     raeburn  2240: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2241: 
1.586     raeburn  2242: input: 4 arguments (two required, two optional) - 
                   2243:     $domain - domain of new user
                   2244:     $name - name of form element
                   2245:     $default - Value of 'default' causes a default item to be first 
                   2246:                             option, and selected by default. 
                   2247:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2248:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2249: output: returns 2 items: 
1.586     raeburn  2250: (a) form element which contains either:
                   2251:    (i) <select name="$name">
                   2252:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2253:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2254:        </select>
                   2255:        form item if there are multiple library servers in $domain, or
                   2256:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2257:        if there is only one library server in $domain.
                   2258: 
                   2259: (b) number of library servers found.
                   2260: 
                   2261: See loncreateuser.pm for example of use.
1.35      matthew  2262: 
                   2263: =cut
                   2264: 
                   2265: #-------------------------------------------
1.586     raeburn  2266: sub home_server_form_item {
                   2267:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2268:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2269:     my $result;
                   2270:     my $numlib = keys(%servers);
                   2271:     if ($numlib > 1) {
                   2272:         $result .= '<select name="'.$name.'" />'."\n";
                   2273:         if ($default) {
1.804     bisitz   2274:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2275:                        '</option>'."\n";
                   2276:         }
                   2277:         foreach my $hostid (sort(keys(%servers))) {
                   2278:             $result.= '<option value="'.$hostid.'">'.
                   2279: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2280:         }
                   2281:         $result .= '</select>'."\n";
                   2282:     } elsif ($numlib == 1) {
                   2283:         my $hostid;
                   2284:         foreach my $item (keys(%servers)) {
                   2285:             $hostid = $item;
                   2286:         }
                   2287:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2288:                    $hostid.'" />';
                   2289:                    if (!$hide) {
                   2290:                        $result .= $hostid.' '.$servers{$hostid};
                   2291:                    }
                   2292:                    $result .= "\n";
                   2293:     } elsif ($default) {
                   2294:         $result .= '<input type="hidden" name="'.$name.
                   2295:                    '" value="default" />';
                   2296:                    if (!$hide) {
                   2297:                        $result .= &mt('default');
                   2298:                    }
                   2299:                    $result .= "\n";
1.33      matthew  2300:     }
1.586     raeburn  2301:     return ($result,$numlib);
1.33      matthew  2302: }
1.112     bowersj2 2303: 
                   2304: =pod
                   2305: 
1.534     albertel 2306: =back 
                   2307: 
1.112     bowersj2 2308: =cut
1.87      matthew  2309: 
                   2310: ###############################################################
1.112     bowersj2 2311: ##                  Decoding User Agent                      ##
1.87      matthew  2312: ###############################################################
                   2313: 
                   2314: =pod
                   2315: 
1.112     bowersj2 2316: =head1 Decoding the User Agent
                   2317: 
                   2318: =over 4
                   2319: 
                   2320: =item * &decode_user_agent()
1.87      matthew  2321: 
                   2322: Inputs: $r
                   2323: 
                   2324: Outputs:
                   2325: 
                   2326: =over 4
                   2327: 
1.112     bowersj2 2328: =item * $httpbrowser
1.87      matthew  2329: 
1.112     bowersj2 2330: =item * $clientbrowser
1.87      matthew  2331: 
1.112     bowersj2 2332: =item * $clientversion
1.87      matthew  2333: 
1.112     bowersj2 2334: =item * $clientmathml
1.87      matthew  2335: 
1.112     bowersj2 2336: =item * $clientunicode
1.87      matthew  2337: 
1.112     bowersj2 2338: =item * $clientos
1.87      matthew  2339: 
1.1075.2.42  raeburn  2340: =item * $clientmobile
                   2341: 
                   2342: =item * $clientinfo
                   2343: 
1.1075.2.77  raeburn  2344: =item * $clientosversion
                   2345: 
1.87      matthew  2346: =back
                   2347: 
1.157     matthew  2348: =back 
                   2349: 
1.87      matthew  2350: =cut
                   2351: 
                   2352: ###############################################################
                   2353: ###############################################################
                   2354: sub decode_user_agent {
1.247     albertel 2355:     my ($r)=@_;
1.87      matthew  2356:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2357:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2358:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2359:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2360:     my $clientbrowser='unknown';
                   2361:     my $clientversion='0';
                   2362:     my $clientmathml='';
                   2363:     my $clientunicode='0';
1.1075.2.42  raeburn  2364:     my $clientmobile=0;
1.1075.2.77  raeburn  2365:     my $clientosversion='';
1.87      matthew  2366:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76  raeburn  2367:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  2368: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2369: 	    $clientbrowser=$bname;
                   2370:             $httpbrowser=~/$vreg/i;
                   2371: 	    $clientversion=$1;
                   2372:             $clientmathml=($clientversion>=$minv);
                   2373:             $clientunicode=($clientversion>=$univ);
                   2374: 	}
                   2375:     }
                   2376:     my $clientos='unknown';
1.1075.2.42  raeburn  2377:     my $clientinfo;
1.87      matthew  2378:     if (($httpbrowser=~/linux/i) ||
                   2379:         ($httpbrowser=~/unix/i) ||
                   2380:         ($httpbrowser=~/ux/i) ||
                   2381:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2382:     if (($httpbrowser=~/vax/i) ||
                   2383:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2384:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2385:     if (($httpbrowser=~/mac/i) ||
                   2386:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77  raeburn  2387:     if ($httpbrowser=~/win/i) {
                   2388:         $clientos='win';
                   2389:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   2390:             $clientosversion = $1;
                   2391:         }
                   2392:     }
1.87      matthew  2393:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42  raeburn  2394:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2395:         $clientmobile=lc($1);
                   2396:     }
                   2397:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2398:         $clientinfo = 'firefox-'.$1;
                   2399:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2400:         $clientinfo = 'chromeframe-'.$1;
                   2401:     }
1.87      matthew  2402:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77  raeburn  2403:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   2404:             $clientosversion);
1.87      matthew  2405: }
                   2406: 
1.32      matthew  2407: ###############################################################
                   2408: ##    Authentication changing form generation subroutines    ##
                   2409: ###############################################################
                   2410: ##
                   2411: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2412: ## hash, and have reasonable default values.
                   2413: ##
                   2414: ##    formname = the name given in the <form> tag.
1.35      matthew  2415: #-------------------------------------------
                   2416: 
1.45      matthew  2417: =pod
                   2418: 
1.112     bowersj2 2419: =head1 Authentication Routines
                   2420: 
                   2421: =over 4
                   2422: 
1.648     raeburn  2423: =item * &authform_xxxxxx()
1.35      matthew  2424: 
                   2425: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2426: handle some of the conveniences required for authentication forms.  
                   2427: This is not an optimal method, but it works.  
                   2428: 
                   2429: =over 4
                   2430: 
1.112     bowersj2 2431: =item * authform_header
1.35      matthew  2432: 
1.112     bowersj2 2433: =item * authform_authorwarning
1.35      matthew  2434: 
1.112     bowersj2 2435: =item * authform_nochange
1.35      matthew  2436: 
1.112     bowersj2 2437: =item * authform_kerberos
1.35      matthew  2438: 
1.112     bowersj2 2439: =item * authform_internal
1.35      matthew  2440: 
1.112     bowersj2 2441: =item * authform_filesystem
1.35      matthew  2442: 
                   2443: =back
                   2444: 
1.648     raeburn  2445: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2446: 
1.35      matthew  2447: =cut
                   2448: 
                   2449: #-------------------------------------------
1.32      matthew  2450: sub authform_header{  
                   2451:     my %in = (
                   2452:         formname => 'cu',
1.80      albertel 2453:         kerb_def_dom => '',
1.32      matthew  2454:         @_,
                   2455:     );
                   2456:     $in{'formname'} = 'document.' . $in{'formname'};
                   2457:     my $result='';
1.80      albertel 2458: 
                   2459: #---------------------------------------------- Code for upper case translation
                   2460:     my $Javascript_toUpperCase;
                   2461:     unless ($in{kerb_def_dom}) {
                   2462:         $Javascript_toUpperCase =<<"END";
                   2463:         switch (choice) {
                   2464:            case 'krb': currentform.elements[choicearg].value =
                   2465:                currentform.elements[choicearg].value.toUpperCase();
                   2466:                break;
                   2467:            default:
                   2468:         }
                   2469: END
                   2470:     } else {
                   2471:         $Javascript_toUpperCase = "";
                   2472:     }
                   2473: 
1.165     raeburn  2474:     my $radioval = "'nochange'";
1.591     raeburn  2475:     if (defined($in{'curr_authtype'})) {
                   2476:         if ($in{'curr_authtype'} ne '') {
                   2477:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2478:         }
1.174     matthew  2479:     }
1.165     raeburn  2480:     my $argfield = 'null';
1.591     raeburn  2481:     if (defined($in{'mode'})) {
1.165     raeburn  2482:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2483:             if (defined($in{'curr_autharg'})) {
                   2484:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2485:                     $argfield = "'$in{'curr_autharg'}'";
                   2486:                 }
                   2487:             }
                   2488:         }
                   2489:     }
                   2490: 
1.32      matthew  2491:     $result.=<<"END";
                   2492: var current = new Object();
1.165     raeburn  2493: current.radiovalue = $radioval;
                   2494: current.argfield = $argfield;
1.32      matthew  2495: 
                   2496: function changed_radio(choice,currentform) {
                   2497:     var choicearg = choice + 'arg';
                   2498:     // If a radio button in changed, we need to change the argfield
                   2499:     if (current.radiovalue != choice) {
                   2500:         current.radiovalue = choice;
                   2501:         if (current.argfield != null) {
                   2502:             currentform.elements[current.argfield].value = '';
                   2503:         }
                   2504:         if (choice == 'nochange') {
                   2505:             current.argfield = null;
                   2506:         } else {
                   2507:             current.argfield = choicearg;
                   2508:             switch(choice) {
                   2509:                 case 'krb': 
                   2510:                     currentform.elements[current.argfield].value = 
                   2511:                         "$in{'kerb_def_dom'}";
                   2512:                 break;
                   2513:               default:
                   2514:                 break;
                   2515:             }
                   2516:         }
                   2517:     }
                   2518:     return;
                   2519: }
1.22      www      2520: 
1.32      matthew  2521: function changed_text(choice,currentform) {
                   2522:     var choicearg = choice + 'arg';
                   2523:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2524:         $Javascript_toUpperCase
1.32      matthew  2525:         // clear old field
                   2526:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2527:             currentform.elements[current.argfield].value = '';
                   2528:         }
                   2529:         current.argfield = choicearg;
                   2530:     }
                   2531:     set_auth_radio_buttons(choice,currentform);
                   2532:     return;
1.20      www      2533: }
1.32      matthew  2534: 
                   2535: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2536:     var numauthchoices = currentform.login.length;
                   2537:     if (typeof numauthchoices  == "undefined") {
                   2538:         return;
                   2539:     } 
1.32      matthew  2540:     var i=0;
1.986     raeburn  2541:     while (i < numauthchoices) {
1.32      matthew  2542:         if (currentform.login[i].value == newvalue) { break; }
                   2543:         i++;
                   2544:     }
1.986     raeburn  2545:     if (i == numauthchoices) {
1.32      matthew  2546:         return;
                   2547:     }
                   2548:     current.radiovalue = newvalue;
                   2549:     currentform.login[i].checked = true;
                   2550:     return;
                   2551: }
                   2552: END
                   2553:     return $result;
                   2554: }
                   2555: 
1.1075.2.20  raeburn  2556: sub authform_authorwarning {
1.32      matthew  2557:     my $result='';
1.144     matthew  2558:     $result='<i>'.
                   2559:         &mt('As a general rule, only authors or co-authors should be '.
                   2560:             'filesystem authenticated '.
                   2561:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2562:     return $result;
                   2563: }
                   2564: 
1.1075.2.20  raeburn  2565: sub authform_nochange {
1.32      matthew  2566:     my %in = (
                   2567:               formname => 'document.cu',
                   2568:               kerb_def_dom => 'MSU.EDU',
                   2569:               @_,
                   2570:           );
1.1075.2.20  raeburn  2571:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2572:     my $result;
1.1075.2.20  raeburn  2573:     if (!$authnum) {
                   2574:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2575:     } else {
                   2576:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2577:                   '<input type="radio" name="login" value="nochange" '.
                   2578:                   'checked="checked" onclick="'.
1.281     albertel 2579:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2580: 	    '</label>';
1.586     raeburn  2581:     }
1.32      matthew  2582:     return $result;
                   2583: }
                   2584: 
1.591     raeburn  2585: sub authform_kerberos {
1.32      matthew  2586:     my %in = (
                   2587:               formname => 'document.cu',
                   2588:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2589:               kerb_def_auth => 'krb4',
1.32      matthew  2590:               @_,
                   2591:               );
1.586     raeburn  2592:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2593:         $autharg,$jscall);
1.1075.2.20  raeburn  2594:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2595:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2596:        $check5 = ' checked="checked"';
1.80      albertel 2597:     } else {
1.772     bisitz   2598:        $check4 = ' checked="checked"';
1.80      albertel 2599:     }
1.165     raeburn  2600:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2601:     if (defined($in{'curr_authtype'})) {
                   2602:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2603:             $krbcheck = ' checked="checked"';
1.623     raeburn  2604:             if (defined($in{'mode'})) {
                   2605:                 if ($in{'mode'} eq 'modifyuser') {
                   2606:                     $krbcheck = '';
                   2607:                 }
                   2608:             }
1.591     raeburn  2609:             if (defined($in{'curr_kerb_ver'})) {
                   2610:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2611:                     $check5 = ' checked="checked"';
1.591     raeburn  2612:                     $check4 = '';
                   2613:                 } else {
1.772     bisitz   2614:                     $check4 = ' checked="checked"';
1.591     raeburn  2615:                     $check5 = '';
                   2616:                 }
1.586     raeburn  2617:             }
1.591     raeburn  2618:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2619:                 $krbarg = $in{'curr_autharg'};
                   2620:             }
1.586     raeburn  2621:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2622:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2623:                     $result = 
                   2624:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2625:         $in{'curr_autharg'},$krbver);
                   2626:                 } else {
                   2627:                     $result =
                   2628:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2629:                 }
                   2630:                 return $result; 
                   2631:             }
                   2632:         }
                   2633:     } else {
                   2634:         if ($authnum == 1) {
1.784     bisitz   2635:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2636:         }
                   2637:     }
1.586     raeburn  2638:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2639:         return;
1.587     raeburn  2640:     } elsif ($authtype eq '') {
1.591     raeburn  2641:         if (defined($in{'mode'})) {
1.587     raeburn  2642:             if ($in{'mode'} eq 'modifycourse') {
                   2643:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2644:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2645:                 }
                   2646:             }
                   2647:         }
1.586     raeburn  2648:     }
                   2649:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2650:     if ($authtype eq '') {
                   2651:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2652:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2653:                     $krbcheck.' />';
                   2654:     }
                   2655:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20  raeburn  2656:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2657:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  2658:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2659:          $in{'curr_authtype'} eq 'krb4')) {
                   2660:         $result .= &mt
1.144     matthew  2661:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2662:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2663:          '<label>'.$authtype,
1.281     albertel 2664:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2665:              'value="'.$krbarg.'" '.
1.144     matthew  2666:              'onchange="'.$jscall.'" />',
1.281     albertel 2667:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2668:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2669: 	 '</label>');
1.586     raeburn  2670:     } elsif ($can_assign{'krb4'}) {
                   2671:         $result .= &mt
                   2672:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2673:          '[_3] Version 4 [_4]',
                   2674:          '<label>'.$authtype,
                   2675:          '</label><input type="text" size="10" name="krbarg" '.
                   2676:              'value="'.$krbarg.'" '.
                   2677:              'onchange="'.$jscall.'" />',
                   2678:          '<label><input type="hidden" name="krbver" value="4" />',
                   2679:          '</label>');
                   2680:     } elsif ($can_assign{'krb5'}) {
                   2681:         $result .= &mt
                   2682:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2683:          '[_3] Version 5 [_4]',
                   2684:          '<label>'.$authtype,
                   2685:          '</label><input type="text" size="10" name="krbarg" '.
                   2686:              'value="'.$krbarg.'" '.
                   2687:              'onchange="'.$jscall.'" />',
                   2688:          '<label><input type="hidden" name="krbver" value="5" />',
                   2689:          '</label>');
                   2690:     }
1.32      matthew  2691:     return $result;
                   2692: }
                   2693: 
1.1075.2.20  raeburn  2694: sub authform_internal {
1.586     raeburn  2695:     my %in = (
1.32      matthew  2696:                 formname => 'document.cu',
                   2697:                 kerb_def_dom => 'MSU.EDU',
                   2698:                 @_,
                   2699:                 );
1.586     raeburn  2700:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2701:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2702:     if (defined($in{'curr_authtype'})) {
                   2703:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2704:             if ($can_assign{'int'}) {
1.772     bisitz   2705:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2706:                 if (defined($in{'mode'})) {
                   2707:                     if ($in{'mode'} eq 'modifyuser') {
                   2708:                         $intcheck = '';
                   2709:                     }
                   2710:                 }
1.591     raeburn  2711:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2712:                     $intarg = $in{'curr_autharg'};
                   2713:                 }
                   2714:             } else {
                   2715:                 $result = &mt('Currently internally authenticated.');
                   2716:                 return $result;
1.165     raeburn  2717:             }
                   2718:         }
1.586     raeburn  2719:     } else {
                   2720:         if ($authnum == 1) {
1.784     bisitz   2721:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2722:         }
                   2723:     }
                   2724:     if (!$can_assign{'int'}) {
                   2725:         return;
1.587     raeburn  2726:     } elsif ($authtype eq '') {
1.591     raeburn  2727:         if (defined($in{'mode'})) {
1.587     raeburn  2728:             if ($in{'mode'} eq 'modifycourse') {
                   2729:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2730:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2731:                 }
                   2732:             }
                   2733:         }
1.165     raeburn  2734:     }
1.586     raeburn  2735:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2736:     if ($authtype eq '') {
                   2737:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2738:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2739:     }
1.605     bisitz   2740:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2741:                $intarg.'" onchange="'.$jscall.'" />';
                   2742:     $result = &mt
1.144     matthew  2743:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2744:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2745:     $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  2746:     return $result;
                   2747: }
                   2748: 
1.1075.2.20  raeburn  2749: sub authform_local {
1.32      matthew  2750:     my %in = (
                   2751:               formname => 'document.cu',
                   2752:               kerb_def_dom => 'MSU.EDU',
                   2753:               @_,
                   2754:               );
1.586     raeburn  2755:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2756:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2757:     if (defined($in{'curr_authtype'})) {
                   2758:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2759:             if ($can_assign{'loc'}) {
1.772     bisitz   2760:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2761:                 if (defined($in{'mode'})) {
                   2762:                     if ($in{'mode'} eq 'modifyuser') {
                   2763:                         $loccheck = '';
                   2764:                     }
                   2765:                 }
1.591     raeburn  2766:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2767:                     $locarg = $in{'curr_autharg'};
                   2768:                 }
                   2769:             } else {
                   2770:                 $result = &mt('Currently using local (institutional) authentication.');
                   2771:                 return $result;
1.165     raeburn  2772:             }
                   2773:         }
1.586     raeburn  2774:     } else {
                   2775:         if ($authnum == 1) {
1.784     bisitz   2776:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2777:         }
                   2778:     }
                   2779:     if (!$can_assign{'loc'}) {
                   2780:         return;
1.587     raeburn  2781:     } elsif ($authtype eq '') {
1.591     raeburn  2782:         if (defined($in{'mode'})) {
1.587     raeburn  2783:             if ($in{'mode'} eq 'modifycourse') {
                   2784:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2785:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2786:                 }
                   2787:             }
                   2788:         }
1.165     raeburn  2789:     }
1.586     raeburn  2790:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2791:     if ($authtype eq '') {
                   2792:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2793:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2794:                     $jscall.'" />';
                   2795:     }
                   2796:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2797:                $locarg.'" onchange="'.$jscall.'" />';
                   2798:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2799:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2800:     return $result;
                   2801: }
                   2802: 
1.1075.2.20  raeburn  2803: sub authform_filesystem {
1.32      matthew  2804:     my %in = (
                   2805:               formname => 'document.cu',
                   2806:               kerb_def_dom => 'MSU.EDU',
                   2807:               @_,
                   2808:               );
1.586     raeburn  2809:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2810:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2811:     if (defined($in{'curr_authtype'})) {
                   2812:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2813:             if ($can_assign{'fsys'}) {
1.772     bisitz   2814:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2815:                 if (defined($in{'mode'})) {
                   2816:                     if ($in{'mode'} eq 'modifyuser') {
                   2817:                         $fsyscheck = '';
                   2818:                     }
                   2819:                 }
1.586     raeburn  2820:             } else {
                   2821:                 $result = &mt('Currently Filesystem Authenticated.');
                   2822:                 return $result;
                   2823:             }           
                   2824:         }
                   2825:     } else {
                   2826:         if ($authnum == 1) {
1.784     bisitz   2827:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2828:         }
                   2829:     }
                   2830:     if (!$can_assign{'fsys'}) {
                   2831:         return;
1.587     raeburn  2832:     } elsif ($authtype eq '') {
1.591     raeburn  2833:         if (defined($in{'mode'})) {
1.587     raeburn  2834:             if ($in{'mode'} eq 'modifycourse') {
                   2835:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2836:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2837:                 }
                   2838:             }
                   2839:         }
1.586     raeburn  2840:     }
                   2841:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2842:     if ($authtype eq '') {
                   2843:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2844:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2845:                     $jscall.'" />';
                   2846:     }
                   2847:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2848:                ' onchange="'.$jscall.'" />';
                   2849:     $result = &mt
1.144     matthew  2850:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2851:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2852:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2853:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2854:                   'onchange="'.$jscall.'" />');
1.32      matthew  2855:     return $result;
                   2856: }
                   2857: 
1.586     raeburn  2858: sub get_assignable_auth {
                   2859:     my ($dom) = @_;
                   2860:     if ($dom eq '') {
                   2861:         $dom = $env{'request.role.domain'};
                   2862:     }
                   2863:     my %can_assign = (
                   2864:                           krb4 => 1,
                   2865:                           krb5 => 1,
                   2866:                           int  => 1,
                   2867:                           loc  => 1,
                   2868:                      );
                   2869:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2870:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2871:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2872:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2873:             my $context;
                   2874:             if ($env{'request.role'} =~ /^au/) {
                   2875:                 $context = 'author';
                   2876:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2877:                 $context = 'domain';
                   2878:             } elsif ($env{'request.course.id'}) {
                   2879:                 $context = 'course';
                   2880:             }
                   2881:             if ($context) {
                   2882:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2883:                    %can_assign = %{$authhash->{$context}}; 
                   2884:                 }
                   2885:             }
                   2886:         }
                   2887:     }
                   2888:     my $authnum = 0;
                   2889:     foreach my $key (keys(%can_assign)) {
                   2890:         if ($can_assign{$key}) {
                   2891:             $authnum ++;
                   2892:         }
                   2893:     }
                   2894:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2895:         $authnum --;
                   2896:     }
                   2897:     return ($authnum,%can_assign);
                   2898: }
                   2899: 
1.80      albertel 2900: ###############################################################
                   2901: ##    Get Kerberos Defaults for Domain                 ##
                   2902: ###############################################################
                   2903: ##
                   2904: ## Returns default kerberos version and an associated argument
                   2905: ## as listed in file domain.tab. If not listed, provides
                   2906: ## appropriate default domain and kerberos version.
                   2907: ##
                   2908: #-------------------------------------------
                   2909: 
                   2910: =pod
                   2911: 
1.648     raeburn  2912: =item * &get_kerberos_defaults()
1.80      albertel 2913: 
                   2914: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2915: version and domain. If not found, it defaults to version 4 and the 
                   2916: domain of the server.
1.80      albertel 2917: 
1.648     raeburn  2918: =over 4
                   2919: 
1.80      albertel 2920: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2921: 
1.648     raeburn  2922: =back
                   2923: 
                   2924: =back
                   2925: 
1.80      albertel 2926: =cut
                   2927: 
                   2928: #-------------------------------------------
                   2929: sub get_kerberos_defaults {
                   2930:     my $domain=shift;
1.641     raeburn  2931:     my ($krbdef,$krbdefdom);
                   2932:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2933:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2934:         $krbdef = $domdefaults{'auth_def'};
                   2935:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2936:     } else {
1.80      albertel 2937:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2938:         my $krbdefdom=$1;
                   2939:         $krbdefdom=~tr/a-z/A-Z/;
                   2940:         $krbdef = "krb4";
                   2941:     }
                   2942:     return ($krbdef,$krbdefdom);
                   2943: }
1.112     bowersj2 2944: 
1.32      matthew  2945: 
1.46      matthew  2946: ###############################################################
                   2947: ##                Thesaurus Functions                        ##
                   2948: ###############################################################
1.20      www      2949: 
1.46      matthew  2950: =pod
1.20      www      2951: 
1.112     bowersj2 2952: =head1 Thesaurus Functions
                   2953: 
                   2954: =over 4
                   2955: 
1.648     raeburn  2956: =item * &initialize_keywords()
1.46      matthew  2957: 
                   2958: Initializes the package variable %Keywords if it is empty.  Uses the
                   2959: package variable $thesaurus_db_file.
                   2960: 
                   2961: =cut
                   2962: 
                   2963: ###################################################
                   2964: 
                   2965: sub initialize_keywords {
                   2966:     return 1 if (scalar keys(%Keywords));
                   2967:     # If we are here, %Keywords is empty, so fill it up
                   2968:     #   Make sure the file we need exists...
                   2969:     if (! -e $thesaurus_db_file) {
                   2970:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2971:                                  " failed because it does not exist");
                   2972:         return 0;
                   2973:     }
                   2974:     #   Set up the hash as a database
                   2975:     my %thesaurus_db;
                   2976:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2977:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2978:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2979:                                  $thesaurus_db_file);
                   2980:         return 0;
                   2981:     } 
                   2982:     #  Get the average number of appearances of a word.
                   2983:     my $avecount = $thesaurus_db{'average.count'};
                   2984:     #  Put keywords (those that appear > average) into %Keywords
                   2985:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2986:         my ($count,undef) = split /:/,$data;
                   2987:         $Keywords{$word}++ if ($count > $avecount);
                   2988:     }
                   2989:     untie %thesaurus_db;
                   2990:     # Remove special values from %Keywords.
1.356     albertel 2991:     foreach my $value ('total.count','average.count') {
                   2992:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2993:   }
1.46      matthew  2994:     return 1;
                   2995: }
                   2996: 
                   2997: ###################################################
                   2998: 
                   2999: =pod
                   3000: 
1.648     raeburn  3001: =item * &keyword($word)
1.46      matthew  3002: 
                   3003: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3004: than the average number of times in the thesaurus database.  Calls 
                   3005: &initialize_keywords
                   3006: 
                   3007: =cut
                   3008: 
                   3009: ###################################################
1.20      www      3010: 
                   3011: sub keyword {
1.46      matthew  3012:     return if (!&initialize_keywords());
                   3013:     my $word=lc(shift());
                   3014:     $word=~s/\W//g;
                   3015:     return exists($Keywords{$word});
1.20      www      3016: }
1.46      matthew  3017: 
                   3018: ###############################################################
                   3019: 
                   3020: =pod 
1.20      www      3021: 
1.648     raeburn  3022: =item * &get_related_words()
1.46      matthew  3023: 
1.160     matthew  3024: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3025: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3026: will be returned.  The order of the words returned is determined by the
                   3027: database which holds them.
                   3028: 
                   3029: Uses global $thesaurus_db_file.
                   3030: 
1.1057    foxr     3031: 
1.46      matthew  3032: =cut
                   3033: 
                   3034: ###############################################################
                   3035: sub get_related_words {
                   3036:     my $keyword = shift;
                   3037:     my %thesaurus_db;
                   3038:     if (! -e $thesaurus_db_file) {
                   3039:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3040:                                  "failed because the file does not exist");
                   3041:         return ();
                   3042:     }
                   3043:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3044:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3045:         return ();
                   3046:     } 
                   3047:     my @Words=();
1.429     www      3048:     my $count=0;
1.46      matthew  3049:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3050: 	# The first element is the number of times
                   3051: 	# the word appears.  We do not need it now.
1.429     www      3052: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3053: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3054: 	my $threshold=$mostfrequentcount/10;
                   3055:         foreach my $possibleword (@RelatedWords) {
                   3056:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3057:             if ($wordcount>$threshold) {
                   3058: 		push(@Words,$word);
                   3059:                 $count++;
                   3060:                 if ($count>10) { last; }
                   3061: 	    }
1.20      www      3062:         }
                   3063:     }
1.46      matthew  3064:     untie %thesaurus_db;
                   3065:     return @Words;
1.14      harris41 3066: }
1.46      matthew  3067: 
1.112     bowersj2 3068: =pod
                   3069: 
                   3070: =back
                   3071: 
                   3072: =cut
1.61      www      3073: 
                   3074: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3075: =pod
                   3076: 
1.112     bowersj2 3077: =head1 User Name Functions
                   3078: 
                   3079: =over 4
                   3080: 
1.648     raeburn  3081: =item * &plainname($uname,$udom,$first)
1.81      albertel 3082: 
1.112     bowersj2 3083: Takes a users logon name and returns it as a string in
1.226     albertel 3084: "first middle last generation" form 
                   3085: if $first is set to 'lastname' then it returns it as
                   3086: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3087: 
                   3088: =cut
1.61      www      3089: 
1.295     www      3090: 
1.81      albertel 3091: ###############################################################
1.61      www      3092: sub plainname {
1.226     albertel 3093:     my ($uname,$udom,$first)=@_;
1.537     albertel 3094:     return if (!defined($uname) || !defined($udom));
1.295     www      3095:     my %names=&getnames($uname,$udom);
1.226     albertel 3096:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3097: 					  $names{'middlename'},
                   3098: 					  $names{'lastname'},
                   3099: 					  $names{'generation'},$first);
                   3100:     $name=~s/^\s+//;
1.62      www      3101:     $name=~s/\s+$//;
                   3102:     $name=~s/\s+/ /g;
1.353     albertel 3103:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3104:     return $name;
1.61      www      3105: }
1.66      www      3106: 
                   3107: # -------------------------------------------------------------------- Nickname
1.81      albertel 3108: =pod
                   3109: 
1.648     raeburn  3110: =item * &nickname($uname,$udom)
1.81      albertel 3111: 
                   3112: Gets a users name and returns it as a string as
                   3113: 
                   3114: "&quot;nickname&quot;"
1.66      www      3115: 
1.81      albertel 3116: if the user has a nickname or
                   3117: 
                   3118: "first middle last generation"
                   3119: 
                   3120: if the user does not
                   3121: 
                   3122: =cut
1.66      www      3123: 
                   3124: sub nickname {
                   3125:     my ($uname,$udom)=@_;
1.537     albertel 3126:     return if (!defined($uname) || !defined($udom));
1.295     www      3127:     my %names=&getnames($uname,$udom);
1.68      albertel 3128:     my $name=$names{'nickname'};
1.66      www      3129:     if ($name) {
                   3130:        $name='&quot;'.$name.'&quot;'; 
                   3131:     } else {
                   3132:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3133: 	     $names{'lastname'}.' '.$names{'generation'};
                   3134:        $name=~s/\s+$//;
                   3135:        $name=~s/\s+/ /g;
                   3136:     }
                   3137:     return $name;
                   3138: }
                   3139: 
1.295     www      3140: sub getnames {
                   3141:     my ($uname,$udom)=@_;
1.537     albertel 3142:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3143:     if ($udom eq 'public' && $uname eq 'public') {
                   3144: 	return ('lastname' => &mt('Public'));
                   3145:     }
1.295     www      3146:     my $id=$uname.':'.$udom;
                   3147:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3148:     if ($cached) {
                   3149: 	return %{$names};
                   3150:     } else {
                   3151: 	my %loadnames=&Apache::lonnet::get('environment',
                   3152:                     ['firstname','middlename','lastname','generation','nickname'],
                   3153: 					 $udom,$uname);
                   3154: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3155: 	return %loadnames;
                   3156:     }
                   3157: }
1.61      www      3158: 
1.542     raeburn  3159: # -------------------------------------------------------------------- getemails
1.648     raeburn  3160: 
1.542     raeburn  3161: =pod
                   3162: 
1.648     raeburn  3163: =item * &getemails($uname,$udom)
1.542     raeburn  3164: 
                   3165: Gets a user's email information and returns it as a hash with keys:
                   3166: notification, critnotification, permanentemail
                   3167: 
                   3168: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3169: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3170:  
1.648     raeburn  3171: 
1.542     raeburn  3172: =cut
                   3173: 
1.648     raeburn  3174: 
1.466     albertel 3175: sub getemails {
                   3176:     my ($uname,$udom)=@_;
                   3177:     if ($udom eq 'public' && $uname eq 'public') {
                   3178: 	return;
                   3179:     }
1.467     www      3180:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3181:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3182:     my $id=$uname.':'.$udom;
                   3183:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3184:     if ($cached) {
                   3185: 	return %{$names};
                   3186:     } else {
                   3187: 	my %loadnames=&Apache::lonnet::get('environment',
                   3188:                     			   ['notification','critnotification',
                   3189: 					    'permanentemail'],
                   3190: 					   $udom,$uname);
                   3191: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3192: 	return %loadnames;
                   3193:     }
                   3194: }
                   3195: 
1.551     albertel 3196: sub flush_email_cache {
                   3197:     my ($uname,$udom)=@_;
                   3198:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3199:     if (!$uname) { $uname=$env{'user.name'};   }
                   3200:     return if ($udom eq 'public' && $uname eq 'public');
                   3201:     my $id=$uname.':'.$udom;
                   3202:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3203: }
                   3204: 
1.728     raeburn  3205: # -------------------------------------------------------------------- getlangs
                   3206: 
                   3207: =pod
                   3208: 
                   3209: =item * &getlangs($uname,$udom)
                   3210: 
                   3211: Gets a user's language preference and returns it as a hash with key:
                   3212: language.
                   3213: 
                   3214: =cut
                   3215: 
                   3216: 
                   3217: sub getlangs {
                   3218:     my ($uname,$udom) = @_;
                   3219:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3220:     if (!$uname) { $uname=$env{'user.name'};   }
                   3221:     my $id=$uname.':'.$udom;
                   3222:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3223:     if ($cached) {
                   3224:         return %{$langs};
                   3225:     } else {
                   3226:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3227:                                            $udom,$uname);
                   3228:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3229:         return %loadlangs;
                   3230:     }
                   3231: }
                   3232: 
                   3233: sub flush_langs_cache {
                   3234:     my ($uname,$udom)=@_;
                   3235:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3236:     if (!$uname) { $uname=$env{'user.name'};   }
                   3237:     return if ($udom eq 'public' && $uname eq 'public');
                   3238:     my $id=$uname.':'.$udom;
                   3239:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3240: }
                   3241: 
1.61      www      3242: # ------------------------------------------------------------------ Screenname
1.81      albertel 3243: 
                   3244: =pod
                   3245: 
1.648     raeburn  3246: =item * &screenname($uname,$udom)
1.81      albertel 3247: 
                   3248: Gets a users screenname and returns it as a string
                   3249: 
                   3250: =cut
1.61      www      3251: 
                   3252: sub screenname {
                   3253:     my ($uname,$udom)=@_;
1.258     albertel 3254:     if ($uname eq $env{'user.name'} &&
                   3255: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3256:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3257:     return $names{'screenname'};
1.62      www      3258: }
                   3259: 
1.212     albertel 3260: 
1.802     bisitz   3261: # ------------------------------------------------------------- Confirm Wrapper
                   3262: =pod
                   3263: 
1.1075.2.42  raeburn  3264: =item * &confirmwrapper($message)
1.802     bisitz   3265: 
                   3266: Wrap messages about completion of operation in box
                   3267: 
                   3268: =cut
                   3269: 
                   3270: sub confirmwrapper {
                   3271:     my ($message)=@_;
                   3272:     if ($message) {
                   3273:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3274:                .$message."\n"
                   3275:                .'</div>'."\n";
                   3276:     } else {
                   3277:         return $message;
                   3278:     }
                   3279: }
                   3280: 
1.62      www      3281: # ------------------------------------------------------------- Message Wrapper
                   3282: 
                   3283: sub messagewrapper {
1.369     www      3284:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3285:     return 
1.441     albertel 3286:         '<a href="/adm/email?compose=individual&amp;'.
                   3287:         'recname='.$username.'&amp;recdom='.$domain.
                   3288: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3289:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3290: }
1.802     bisitz   3291: 
1.74      www      3292: # --------------------------------------------------------------- Notes Wrapper
                   3293: 
                   3294: sub noteswrapper {
                   3295:     my ($link,$un,$do)=@_;
                   3296:     return 
1.896     amueller 3297: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3298: }
1.802     bisitz   3299: 
1.62      www      3300: # ------------------------------------------------------------- Aboutme Wrapper
                   3301: 
                   3302: sub aboutmewrapper {
1.1070    raeburn  3303:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3304:     if (!defined($username)  && !defined($domain)) {
                   3305:         return;
                   3306:     }
1.1075.2.15  raeburn  3307:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3308: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3309: }
                   3310: 
                   3311: # ------------------------------------------------------------ Syllabus Wrapper
                   3312: 
                   3313: sub syllabuswrapper {
1.707     bisitz   3314:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3315:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3316: }
1.14      harris41 3317: 
1.802     bisitz   3318: # -----------------------------------------------------------------------------
                   3319: 
1.208     matthew  3320: sub track_student_link {
1.887     raeburn  3321:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3322:     my $link ="/adm/trackstudent?";
1.208     matthew  3323:     my $title = 'View recent activity';
                   3324:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3325:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3326:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3327:         $title .= ' of this student';
1.268     albertel 3328:     } 
1.208     matthew  3329:     if (defined($target) && $target !~ /^\s*$/) {
                   3330:         $target = qq{target="$target"};
                   3331:     } else {
                   3332:         $target = '';
                   3333:     }
1.268     albertel 3334:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3335:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3336:     $title = &mt($title);
                   3337:     $linktext = &mt($linktext);
1.448     albertel 3338:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3339: 	&help_open_topic('View_recent_activity');
1.208     matthew  3340: }
                   3341: 
1.781     raeburn  3342: sub slot_reservations_link {
                   3343:     my ($linktext,$sname,$sdom,$target) = @_;
                   3344:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3345:     my $title = 'View slot reservation history';
                   3346:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3347:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3348:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3349:         $title .= ' of this student';
                   3350:     }
                   3351:     if (defined($target) && $target !~ /^\s*$/) {
                   3352:         $target = qq{target="$target"};
                   3353:     } else {
                   3354:         $target = '';
                   3355:     }
                   3356:     $title = &mt($title);
                   3357:     $linktext = &mt($linktext);
                   3358:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3359: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3360: 
                   3361: }
                   3362: 
1.508     www      3363: # ===================================================== Display a student photo
                   3364: 
                   3365: 
1.509     albertel 3366: sub student_image_tag {
1.508     www      3367:     my ($domain,$user)=@_;
                   3368:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3369:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3370: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3371:     } else {
                   3372: 	return '';
                   3373:     }
                   3374: }
                   3375: 
1.112     bowersj2 3376: =pod
                   3377: 
                   3378: =back
                   3379: 
                   3380: =head1 Access .tab File Data
                   3381: 
                   3382: =over 4
                   3383: 
1.648     raeburn  3384: =item * &languageids() 
1.112     bowersj2 3385: 
                   3386: returns list of all language ids
                   3387: 
                   3388: =cut
                   3389: 
1.14      harris41 3390: sub languageids {
1.16      harris41 3391:     return sort(keys(%language));
1.14      harris41 3392: }
                   3393: 
1.112     bowersj2 3394: =pod
                   3395: 
1.648     raeburn  3396: =item * &languagedescription() 
1.112     bowersj2 3397: 
                   3398: returns description of a specified language id
                   3399: 
                   3400: =cut
                   3401: 
1.14      harris41 3402: sub languagedescription {
1.125     www      3403:     my $code=shift;
                   3404:     return  ($supported_language{$code}?'* ':'').
                   3405:             $language{$code}.
1.126     www      3406: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3407: }
                   3408: 
1.1048    foxr     3409: =pod
                   3410: 
                   3411: =item * &plainlanguagedescription
                   3412: 
                   3413: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3414: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3415: 
                   3416: =cut
                   3417: 
1.145     www      3418: sub plainlanguagedescription {
                   3419:     my $code=shift;
                   3420:     return $language{$code};
                   3421: }
                   3422: 
1.1048    foxr     3423: =pod
                   3424: 
                   3425: =item * &supportedlanguagecode
                   3426: 
                   3427: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3428: code.
                   3429: 
                   3430: =cut
                   3431: 
1.145     www      3432: sub supportedlanguagecode {
                   3433:     my $code=shift;
                   3434:     return $supported_language{$code};
1.97      www      3435: }
                   3436: 
1.112     bowersj2 3437: =pod
                   3438: 
1.1048    foxr     3439: =item * &latexlanguage()
                   3440: 
                   3441: Given a language key code returns the correspondnig language to use
                   3442: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3443: is no supported hyphenation for the language code.
                   3444: 
                   3445: =cut
                   3446: 
                   3447: sub latexlanguage {
                   3448:     my $code = shift;
                   3449:     return $latex_language{$code};
                   3450: }
                   3451: 
                   3452: =pod
                   3453: 
                   3454: =item * &latexhyphenation()
                   3455: 
                   3456: Same as above but what's supplied is the language as it might be stored
                   3457: in the metadata.
                   3458: 
                   3459: =cut
                   3460: 
                   3461: sub latexhyphenation {
                   3462:     my $key = shift;
                   3463:     return $latex_language_bykey{$key};
                   3464: }
                   3465: 
                   3466: =pod
                   3467: 
1.648     raeburn  3468: =item * &copyrightids() 
1.112     bowersj2 3469: 
                   3470: returns list of all copyrights
                   3471: 
                   3472: =cut
                   3473: 
                   3474: sub copyrightids {
                   3475:     return sort(keys(%cprtag));
                   3476: }
                   3477: 
                   3478: =pod
                   3479: 
1.648     raeburn  3480: =item * &copyrightdescription() 
1.112     bowersj2 3481: 
                   3482: returns description of a specified copyright id
                   3483: 
                   3484: =cut
                   3485: 
                   3486: sub copyrightdescription {
1.166     www      3487:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3488: }
1.197     matthew  3489: 
                   3490: =pod
                   3491: 
1.648     raeburn  3492: =item * &source_copyrightids() 
1.192     taceyjo1 3493: 
                   3494: returns list of all source copyrights
                   3495: 
                   3496: =cut
                   3497: 
                   3498: sub source_copyrightids {
                   3499:     return sort(keys(%scprtag));
                   3500: }
                   3501: 
                   3502: =pod
                   3503: 
1.648     raeburn  3504: =item * &source_copyrightdescription() 
1.192     taceyjo1 3505: 
                   3506: returns description of a specified source copyright id
                   3507: 
                   3508: =cut
                   3509: 
                   3510: sub source_copyrightdescription {
                   3511:     return &mt($scprtag{shift(@_)});
                   3512: }
1.112     bowersj2 3513: 
                   3514: =pod
                   3515: 
1.648     raeburn  3516: =item * &filecategories() 
1.112     bowersj2 3517: 
                   3518: returns list of all file categories
                   3519: 
                   3520: =cut
                   3521: 
                   3522: sub filecategories {
                   3523:     return sort(keys(%category_extensions));
                   3524: }
                   3525: 
                   3526: =pod
                   3527: 
1.648     raeburn  3528: =item * &filecategorytypes() 
1.112     bowersj2 3529: 
                   3530: returns list of file types belonging to a given file
                   3531: category
                   3532: 
                   3533: =cut
                   3534: 
                   3535: sub filecategorytypes {
1.356     albertel 3536:     my ($cat) = @_;
                   3537:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3538: }
                   3539: 
                   3540: =pod
                   3541: 
1.648     raeburn  3542: =item * &fileembstyle() 
1.112     bowersj2 3543: 
                   3544: returns embedding style for a specified file type
                   3545: 
                   3546: =cut
                   3547: 
                   3548: sub fileembstyle {
                   3549:     return $fe{lc(shift(@_))};
1.169     www      3550: }
                   3551: 
1.351     www      3552: sub filemimetype {
                   3553:     return $fm{lc(shift(@_))};
                   3554: }
                   3555: 
1.169     www      3556: 
                   3557: sub filecategoryselect {
                   3558:     my ($name,$value)=@_;
1.189     matthew  3559:     return &select_form($value,$name,
1.970     raeburn  3560:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3561: }
                   3562: 
                   3563: =pod
                   3564: 
1.648     raeburn  3565: =item * &filedescription() 
1.112     bowersj2 3566: 
                   3567: returns description for a specified file type
                   3568: 
                   3569: =cut
                   3570: 
                   3571: sub filedescription {
1.188     matthew  3572:     my $file_description = $fd{lc(shift())};
                   3573:     $file_description =~ s:([\[\]]):~$1:g;
                   3574:     return &mt($file_description);
1.112     bowersj2 3575: }
                   3576: 
                   3577: =pod
                   3578: 
1.648     raeburn  3579: =item * &filedescriptionex() 
1.112     bowersj2 3580: 
                   3581: returns description for a specified file type with
                   3582: extra formatting
                   3583: 
                   3584: =cut
                   3585: 
                   3586: sub filedescriptionex {
                   3587:     my $ex=shift;
1.188     matthew  3588:     my $file_description = $fd{lc($ex)};
                   3589:     $file_description =~ s:([\[\]]):~$1:g;
                   3590:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3591: }
                   3592: 
                   3593: # End of .tab access
                   3594: =pod
                   3595: 
                   3596: =back
                   3597: 
                   3598: =cut
                   3599: 
                   3600: # ------------------------------------------------------------------ File Types
                   3601: sub fileextensions {
                   3602:     return sort(keys(%fe));
                   3603: }
                   3604: 
1.97      www      3605: # ----------------------------------------------------------- Display Languages
                   3606: # returns a hash with all desired display languages
                   3607: #
                   3608: 
                   3609: sub display_languages {
                   3610:     my %languages=();
1.695     raeburn  3611:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3612: 	$languages{$lang}=1;
1.97      www      3613:     }
                   3614:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3615:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3616: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3617: 	    $languages{$lang}=1;
1.97      www      3618:         }
                   3619:     }
                   3620:     return %languages;
1.14      harris41 3621: }
                   3622: 
1.582     albertel 3623: sub languages {
                   3624:     my ($possible_langs) = @_;
1.695     raeburn  3625:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3626:     if (!ref($possible_langs)) {
                   3627: 	if( wantarray ) {
                   3628: 	    return @preferred_langs;
                   3629: 	} else {
                   3630: 	    return $preferred_langs[0];
                   3631: 	}
                   3632:     }
                   3633:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3634:     my @preferred_possibilities;
                   3635:     foreach my $preferred_lang (@preferred_langs) {
                   3636: 	if (exists($possibilities{$preferred_lang})) {
                   3637: 	    push(@preferred_possibilities, $preferred_lang);
                   3638: 	}
                   3639:     }
                   3640:     if( wantarray ) {
                   3641: 	return @preferred_possibilities;
                   3642:     }
                   3643:     return $preferred_possibilities[0];
                   3644: }
                   3645: 
1.742     raeburn  3646: sub user_lang {
                   3647:     my ($touname,$toudom,$fromcid) = @_;
                   3648:     my @userlangs;
                   3649:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3650:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3651:                     $env{'course.'.$fromcid.'.languages'}));
                   3652:     } else {
                   3653:         my %langhash = &getlangs($touname,$toudom);
                   3654:         if ($langhash{'languages'} ne '') {
                   3655:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3656:         } else {
                   3657:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3658:             if ($domdefs{'lang_def'} ne '') {
                   3659:                 @userlangs = ($domdefs{'lang_def'});
                   3660:             }
                   3661:         }
                   3662:     }
                   3663:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3664:     my $user_lh = Apache::localize->get_handle(@languages);
                   3665:     return $user_lh;
                   3666: }
                   3667: 
                   3668: 
1.112     bowersj2 3669: ###############################################################
                   3670: ##               Student Answer Attempts                     ##
                   3671: ###############################################################
                   3672: 
                   3673: =pod
                   3674: 
                   3675: =head1 Alternate Problem Views
                   3676: 
                   3677: =over 4
                   3678: 
1.648     raeburn  3679: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3680:     $getattempt, $regexp, $gradesub)
                   3681: 
                   3682: Return string with previous attempt on problem. Arguments:
                   3683: 
                   3684: =over 4
                   3685: 
                   3686: =item * $symb: Problem, including path
                   3687: 
                   3688: =item * $username: username of the desired student
                   3689: 
                   3690: =item * $domain: domain of the desired student
1.14      harris41 3691: 
1.112     bowersj2 3692: =item * $course: Course ID
1.14      harris41 3693: 
1.112     bowersj2 3694: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3695:     something
1.14      harris41 3696: 
1.112     bowersj2 3697: =item * $regexp: if string matches this regexp, the string will be
                   3698:     sent to $gradesub
1.14      harris41 3699: 
1.112     bowersj2 3700: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3701: 
1.112     bowersj2 3702: =back
1.14      harris41 3703: 
1.112     bowersj2 3704: The output string is a table containing all desired attempts, if any.
1.16      harris41 3705: 
1.112     bowersj2 3706: =cut
1.1       albertel 3707: 
                   3708: sub get_previous_attempt {
1.43      ng       3709:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3710:   my $prevattempts='';
1.43      ng       3711:   no strict 'refs';
1.1       albertel 3712:   if ($symb) {
1.3       albertel 3713:     my (%returnhash)=
                   3714:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3715:     if ($returnhash{'version'}) {
                   3716:       my %lasthash=();
                   3717:       my $version;
                   3718:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3719:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3720: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3721:         }
1.1       albertel 3722:       }
1.596     albertel 3723:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3724:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3725:       my (%typeparts,%lasthidden);
1.945     raeburn  3726:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3727:       foreach my $key (sort(keys(%lasthash))) {
                   3728: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3729: 	if ($#parts > 0) {
1.31      albertel 3730: 	  my $data=$parts[-1];
1.989     raeburn  3731:           next if ($data eq 'foilorder');
1.31      albertel 3732: 	  pop(@parts);
1.1010    www      3733:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3734:           if ($data eq 'type') {
                   3735:               unless ($showsurv) {
                   3736:                   my $id = join(',',@parts);
                   3737:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3738:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3739:                       $lasthidden{$ign.'.'.$id} = 1;
                   3740:                   }
1.945     raeburn  3741:               }
1.1010    www      3742:           } 
1.31      albertel 3743: 	} else {
1.41      ng       3744: 	  if ($#parts == 0) {
                   3745: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3746: 	  } else {
                   3747: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3748: 	  }
1.31      albertel 3749: 	}
1.16      harris41 3750:       }
1.596     albertel 3751:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3752:       if ($getattempt eq '') {
                   3753: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3754:             my @hidden;
                   3755:             if (%typeparts) {
                   3756:                 foreach my $id (keys(%typeparts)) {
                   3757:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3758:                         push(@hidden,$id);
                   3759:                     }
                   3760:                 }
                   3761:             }
                   3762:             $prevattempts.=&start_data_table_row().
                   3763:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3764:             if (@hidden) {
                   3765:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3766:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3767:                     my $hide;
                   3768:                     foreach my $id (@hidden) {
                   3769:                         if ($key =~ /^\Q$id\E/) {
                   3770:                             $hide = 1;
                   3771:                             last;
                   3772:                         }
                   3773:                     }
                   3774:                     if ($hide) {
                   3775:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3776:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3777:                             my $value = &format_previous_attempt_value($key,
                   3778:                                              $returnhash{$version.':'.$key});
                   3779:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3780:                         } else {
                   3781:                             $prevattempts.='<td>&nbsp;</td>';
                   3782:                         }
                   3783:                     } else {
                   3784:                         if ($key =~ /\./) {
                   3785:                             my $value = &format_previous_attempt_value($key,
                   3786:                                               $returnhash{$version.':'.$key});
                   3787:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3788:                         } else {
                   3789:                             $prevattempts.='<td>&nbsp;</td>';
                   3790:                         }
                   3791:                     }
                   3792:                 }
                   3793:             } else {
                   3794: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3795:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3796: 		    my $value = &format_previous_attempt_value($key,
                   3797: 			            $returnhash{$version.':'.$key});
                   3798: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3799: 	        }
                   3800:             }
                   3801: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3802: 	 }
1.1       albertel 3803:       }
1.945     raeburn  3804:       my @currhidden = keys(%lasthidden);
1.596     albertel 3805:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3806:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3807:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3808:           if (%typeparts) {
                   3809:               my $hidden;
                   3810:               foreach my $id (@currhidden) {
                   3811:                   if ($key =~ /^\Q$id\E/) {
                   3812:                       $hidden = 1;
                   3813:                       last;
                   3814:                   }
                   3815:               }
                   3816:               if ($hidden) {
                   3817:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3818:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3819:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3820:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3821:                           $value = &$gradesub($value);
                   3822:                       }
                   3823:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3824:                   } else {
                   3825:                       $prevattempts.='<td>&nbsp;</td>';
                   3826:                   }
                   3827:               } else {
                   3828:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3829:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3830:                       $value = &$gradesub($value);
                   3831:                   }
                   3832:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3833:               }
                   3834:           } else {
                   3835: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3836: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3837:                   $value = &$gradesub($value);
                   3838:               }
                   3839: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3840:           }
1.16      harris41 3841:       }
1.596     albertel 3842:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3843:     } else {
1.596     albertel 3844:       $prevattempts=
                   3845: 	  &start_data_table().&start_data_table_row().
                   3846: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3847: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3848:     }
                   3849:   } else {
1.596     albertel 3850:     $prevattempts=
                   3851: 	  &start_data_table().&start_data_table_row().
                   3852: 	  '<td>'.&mt('No data.').'</td>'.
                   3853: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3854:   }
1.10      albertel 3855: }
                   3856: 
1.581     albertel 3857: sub format_previous_attempt_value {
                   3858:     my ($key,$value) = @_;
1.1011    www      3859:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3860: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3861:     } elsif (ref($value) eq 'ARRAY') {
                   3862: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3863:     } elsif ($key =~ /answerstring$/) {
                   3864:         my %answers = &Apache::lonnet::str2hash($value);
                   3865:         my @anskeys = sort(keys(%answers));
                   3866:         if (@anskeys == 1) {
                   3867:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3868:             if ($answer =~ m{\0}) {
                   3869:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3870:             }
                   3871:             my $tag_internal_answer_name = 'INTERNAL';
                   3872:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3873:                 $value = $answer; 
                   3874:             } else {
                   3875:                 $value = $anskeys[0].'='.$answer;
                   3876:             }
                   3877:         } else {
                   3878:             foreach my $ans (@anskeys) {
                   3879:                 my $answer = $answers{$ans};
1.1001    raeburn  3880:                 if ($answer =~ m{\0}) {
                   3881:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3882:                 }
                   3883:                 $value .=  $ans.'='.$answer.'<br />';;
                   3884:             } 
                   3885:         }
1.581     albertel 3886:     } else {
                   3887: 	$value = &unescape($value);
                   3888:     }
                   3889:     return $value;
                   3890: }
                   3891: 
                   3892: 
1.107     albertel 3893: sub relative_to_absolute {
                   3894:     my ($url,$output)=@_;
                   3895:     my $parser=HTML::TokeParser->new(\$output);
                   3896:     my $token;
                   3897:     my $thisdir=$url;
                   3898:     my @rlinks=();
                   3899:     while ($token=$parser->get_token) {
                   3900: 	if ($token->[0] eq 'S') {
                   3901: 	    if ($token->[1] eq 'a') {
                   3902: 		if ($token->[2]->{'href'}) {
                   3903: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3904: 		}
                   3905: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3906: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3907: 	    } elsif ($token->[1] eq 'base') {
                   3908: 		$thisdir=$token->[2]->{'href'};
                   3909: 	    }
                   3910: 	}
                   3911:     }
                   3912:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3913:     foreach my $link (@rlinks) {
1.726     raeburn  3914: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3915: 		($link=~/^\//) ||
                   3916: 		($link=~/^javascript:/i) ||
                   3917: 		($link=~/^mailto:/i) ||
                   3918: 		($link=~/^\#/)) {
                   3919: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3920: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3921: 	}
                   3922:     }
                   3923: # -------------------------------------------------- Deal with Applet codebases
                   3924:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3925:     return $output;
                   3926: }
                   3927: 
1.112     bowersj2 3928: =pod
                   3929: 
1.648     raeburn  3930: =item * &get_student_view()
1.112     bowersj2 3931: 
                   3932: show a snapshot of what student was looking at
                   3933: 
                   3934: =cut
                   3935: 
1.10      albertel 3936: sub get_student_view {
1.186     albertel 3937:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3938:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3939:   my (%form);
1.10      albertel 3940:   my @elements=('symb','courseid','domain','username');
                   3941:   foreach my $element (@elements) {
1.186     albertel 3942:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3943:   }
1.186     albertel 3944:   if (defined($moreenv)) {
                   3945:       %form=(%form,%{$moreenv});
                   3946:   }
1.236     albertel 3947:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3948:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3949:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3950:   $userview=~s/\<body[^\>]*\>//gi;
                   3951:   $userview=~s/\<\/body\>//gi;
                   3952:   $userview=~s/\<html\>//gi;
                   3953:   $userview=~s/\<\/html\>//gi;
                   3954:   $userview=~s/\<head\>//gi;
                   3955:   $userview=~s/\<\/head\>//gi;
                   3956:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3957:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3958:   if (wantarray) {
                   3959:      return ($userview,$response);
                   3960:   } else {
                   3961:      return $userview;
                   3962:   }
                   3963: }
                   3964: 
                   3965: sub get_student_view_with_retries {
                   3966:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3967: 
                   3968:     my $ok = 0;                 # True if we got a good response.
                   3969:     my $content;
                   3970:     my $response;
                   3971: 
                   3972:     # Try to get the student_view done. within the retries count:
                   3973:     
                   3974:     do {
                   3975:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3976:          $ok      = $response->is_success;
                   3977:          if (!$ok) {
                   3978:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3979:          }
                   3980:          $retries--;
                   3981:     } while (!$ok && ($retries > 0));
                   3982:     
                   3983:     if (!$ok) {
                   3984:        $content = '';          # On error return an empty content.
                   3985:     }
1.651     www      3986:     if (wantarray) {
                   3987:        return ($content, $response);
                   3988:     } else {
                   3989:        return $content;
                   3990:     }
1.11      albertel 3991: }
                   3992: 
1.112     bowersj2 3993: =pod
                   3994: 
1.648     raeburn  3995: =item * &get_student_answers() 
1.112     bowersj2 3996: 
                   3997: show a snapshot of how student was answering problem
                   3998: 
                   3999: =cut
                   4000: 
1.11      albertel 4001: sub get_student_answers {
1.100     sakharuk 4002:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4003:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4004:   my (%moreenv);
1.11      albertel 4005:   my @elements=('symb','courseid','domain','username');
                   4006:   foreach my $element (@elements) {
1.186     albertel 4007:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4008:   }
1.186     albertel 4009:   $moreenv{'grade_target'}='answer';
                   4010:   %moreenv=(%form,%moreenv);
1.497     raeburn  4011:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4012:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4013:   return $userview;
1.1       albertel 4014: }
1.116     albertel 4015: 
                   4016: =pod
                   4017: 
                   4018: =item * &submlink()
                   4019: 
1.242     albertel 4020: Inputs: $text $uname $udom $symb $target
1.116     albertel 4021: 
                   4022: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4023: 
                   4024: =cut
                   4025: 
                   4026: ###############################################
                   4027: sub submlink {
1.242     albertel 4028:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4029:     if (!($uname && $udom)) {
                   4030: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4031: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4032: 	if (!$symb) { $symb=$cursymb; }
                   4033:     }
1.254     matthew  4034:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4035:     $symb=&escape($symb);
1.960     bisitz   4036:     if ($target) { $target=" target=\"$target\""; }
                   4037:     return
                   4038:         '<a href="/adm/grades?command=submission'.
                   4039:         '&amp;symb='.$symb.
                   4040:         '&amp;student='.$uname.
                   4041:         '&amp;userdom='.$udom.'"'.
                   4042:         $target.'>'.$text.'</a>';
1.242     albertel 4043: }
                   4044: ##############################################
                   4045: 
                   4046: =pod
                   4047: 
                   4048: =item * &pgrdlink()
                   4049: 
                   4050: Inputs: $text $uname $udom $symb $target
                   4051: 
                   4052: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4053: 
                   4054: =cut
                   4055: 
                   4056: ###############################################
                   4057: sub pgrdlink {
                   4058:     my $link=&submlink(@_);
                   4059:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4060:     return $link;
                   4061: }
                   4062: ##############################################
                   4063: 
                   4064: =pod
                   4065: 
                   4066: =item * &pprmlink()
                   4067: 
                   4068: Inputs: $text $uname $udom $symb $target
                   4069: 
                   4070: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4071: student and a specific resource
1.242     albertel 4072: 
                   4073: =cut
                   4074: 
                   4075: ###############################################
                   4076: sub pprmlink {
                   4077:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4078:     if (!($uname && $udom)) {
                   4079: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4080: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4081: 	if (!$symb) { $symb=$cursymb; }
                   4082:     }
1.254     matthew  4083:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4084:     $symb=&escape($symb);
1.242     albertel 4085:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4086:     return '<a href="/adm/parmset?command=set&amp;'.
                   4087: 	'symb='.$symb.'&amp;uname='.$uname.
                   4088: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4089: }
                   4090: ##############################################
1.37      matthew  4091: 
1.112     bowersj2 4092: =pod
                   4093: 
                   4094: =back
                   4095: 
                   4096: =cut
                   4097: 
1.37      matthew  4098: ###############################################
1.51      www      4099: 
                   4100: 
                   4101: sub timehash {
1.687     raeburn  4102:     my ($thistime) = @_;
                   4103:     my $timezone = &Apache::lonlocal::gettimezone();
                   4104:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4105:                      ->set_time_zone($timezone);
                   4106:     my $wday = $dt->day_of_week();
                   4107:     if ($wday == 7) { $wday = 0; }
                   4108:     return ( 'second' => $dt->second(),
                   4109:              'minute' => $dt->minute(),
                   4110:              'hour'   => $dt->hour(),
                   4111:              'day'     => $dt->day_of_month(),
                   4112:              'month'   => $dt->month(),
                   4113:              'year'    => $dt->year(),
                   4114:              'weekday' => $wday,
                   4115:              'dayyear' => $dt->day_of_year(),
                   4116:              'dlsav'   => $dt->is_dst() );
1.51      www      4117: }
                   4118: 
1.370     www      4119: sub utc_string {
                   4120:     my ($date)=@_;
1.371     www      4121:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4122: }
                   4123: 
1.51      www      4124: sub maketime {
                   4125:     my %th=@_;
1.687     raeburn  4126:     my ($epoch_time,$timezone,$dt);
                   4127:     $timezone = &Apache::lonlocal::gettimezone();
                   4128:     eval {
                   4129:         $dt = DateTime->new( year   => $th{'year'},
                   4130:                              month  => $th{'month'},
                   4131:                              day    => $th{'day'},
                   4132:                              hour   => $th{'hour'},
                   4133:                              minute => $th{'minute'},
                   4134:                              second => $th{'second'},
                   4135:                              time_zone => $timezone,
                   4136:                          );
                   4137:     };
                   4138:     if (!$@) {
                   4139:         $epoch_time = $dt->epoch;
                   4140:         if ($epoch_time) {
                   4141:             return $epoch_time;
                   4142:         }
                   4143:     }
1.51      www      4144:     return POSIX::mktime(
                   4145:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4146:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4147: }
                   4148: 
                   4149: #########################################
1.51      www      4150: 
                   4151: sub findallcourses {
1.482     raeburn  4152:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4153:     my %roles;
                   4154:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4155:     my %courses;
1.51      www      4156:     my $now=time;
1.482     raeburn  4157:     if (!defined($uname)) {
                   4158:         $uname = $env{'user.name'};
                   4159:     }
                   4160:     if (!defined($udom)) {
                   4161:         $udom = $env{'user.domain'};
                   4162:     }
                   4163:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4164:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4165:         if (!%roles) {
                   4166:             %roles = (
                   4167:                        cc => 1,
1.907     raeburn  4168:                        co => 1,
1.482     raeburn  4169:                        in => 1,
                   4170:                        ep => 1,
                   4171:                        ta => 1,
                   4172:                        cr => 1,
                   4173:                        st => 1,
                   4174:              );
                   4175:         }
                   4176:         foreach my $entry (keys(%roleshash)) {
                   4177:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4178:             if ($trole =~ /^cr/) { 
                   4179:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4180:             } else {
                   4181:                 next if (!exists($roles{$trole}));
                   4182:             }
                   4183:             if ($tend) {
                   4184:                 next if ($tend < $now);
                   4185:             }
                   4186:             if ($tstart) {
                   4187:                 next if ($tstart > $now);
                   4188:             }
1.1058    raeburn  4189:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4190:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4191:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4192:             if ($secpart eq '') {
                   4193:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4194:                 $sec = 'none';
1.1058    raeburn  4195:                 $value .= $cnum.'/';
1.482     raeburn  4196:             } else {
                   4197:                 $cnum = $cnumpart;
                   4198:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4199:                 $value .= $cnum.'/'.$sec;
                   4200:             }
                   4201:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4202:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4203:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4204:                 }
                   4205:             } else {
                   4206:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4207:             }
1.482     raeburn  4208:         }
                   4209:     } else {
                   4210:         foreach my $key (keys(%env)) {
1.483     albertel 4211: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4212:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4213: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4214: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4215: 	        next if (%roles && !exists($roles{$role}));
                   4216: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4217:                 my $active=1;
                   4218:                 if ($starttime) {
                   4219: 		    if ($now<$starttime) { $active=0; }
                   4220:                 }
                   4221:                 if ($endtime) {
                   4222:                     if ($now>$endtime) { $active=0; }
                   4223:                 }
                   4224:                 if ($active) {
1.1058    raeburn  4225:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4226:                     if ($sec eq '') {
                   4227:                         $sec = 'none';
1.1058    raeburn  4228:                     } else {
                   4229:                         $value .= $sec;
                   4230:                     }
                   4231:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4232:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4233:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4234:                         }
                   4235:                     } else {
                   4236:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4237:                     }
1.474     raeburn  4238:                 }
                   4239:             }
1.51      www      4240:         }
                   4241:     }
1.474     raeburn  4242:     return %courses;
1.51      www      4243: }
1.37      matthew  4244: 
1.54      www      4245: ###############################################
1.474     raeburn  4246: 
                   4247: sub blockcheck {
1.1075.2.73  raeburn  4248:     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490     raeburn  4249: 
1.1075.2.73  raeburn  4250:     if (defined($udom) && defined($uname)) {
                   4251:         # If uname and udom are for a course, check for blocks in the course.
                   4252:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4253:             my ($startblock,$endblock,$triggerblock) =
                   4254:                 &get_blocks($setters,$activity,$udom,$uname,$url);
                   4255:             return ($startblock,$endblock,$triggerblock);
                   4256:         }
                   4257:     } else {
1.490     raeburn  4258:         $udom = $env{'user.domain'};
                   4259:         $uname = $env{'user.name'};
                   4260:     }
                   4261: 
1.502     raeburn  4262:     my $startblock = 0;
                   4263:     my $endblock = 0;
1.1062    raeburn  4264:     my $triggerblock = '';
1.482     raeburn  4265:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4266: 
1.490     raeburn  4267:     # If uname is for a user, and activity is course-specific, i.e.,
                   4268:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4269: 
1.490     raeburn  4270:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73  raeburn  4271:          $activity eq 'groups' || $activity eq 'printout') &&
                   4272:         ($env{'request.course.id'})) {
1.490     raeburn  4273:         foreach my $key (keys(%live_courses)) {
                   4274:             if ($key ne $env{'request.course.id'}) {
                   4275:                 delete($live_courses{$key});
                   4276:             }
                   4277:         }
                   4278:     }
                   4279: 
                   4280:     my $otheruser = 0;
                   4281:     my %own_courses;
                   4282:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4283:         # Resource belongs to user other than current user.
                   4284:         $otheruser = 1;
                   4285:         # Gather courses for current user
                   4286:         %own_courses = 
                   4287:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4288:     }
                   4289: 
                   4290:     # Gather active course roles - course coordinator, instructor, 
                   4291:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4292: 
                   4293:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4294:         my ($cdom,$cnum);
                   4295:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4296:             $cdom = $env{'course.'.$course.'.domain'};
                   4297:             $cnum = $env{'course.'.$course.'.num'};
                   4298:         } else {
1.490     raeburn  4299:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4300:         }
                   4301:         my $no_ownblock = 0;
                   4302:         my $no_userblock = 0;
1.533     raeburn  4303:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4304:             # Check if current user has 'evb' priv for this
                   4305:             if (defined($own_courses{$course})) {
                   4306:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4307:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4308:                     if ($sec ne 'none') {
                   4309:                         $checkrole .= '/'.$sec;
                   4310:                     }
                   4311:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4312:                         $no_ownblock = 1;
                   4313:                         last;
                   4314:                     }
                   4315:                 }
                   4316:             }
                   4317:             # if they have 'evb' priv and are currently not playing student
                   4318:             next if (($no_ownblock) &&
                   4319:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4320:         }
1.474     raeburn  4321:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4322:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4323:             if ($sec ne 'none') {
1.482     raeburn  4324:                 $checkrole .= '/'.$sec;
1.474     raeburn  4325:             }
1.490     raeburn  4326:             if ($otheruser) {
                   4327:                 # Resource belongs to user other than current user.
                   4328:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4329:                 my (%allroles,%userroles);
                   4330:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4331:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4332:                         my ($trole,$tdom,$tnum,$tsec);
                   4333:                         if ($entry =~ /^cr/) {
                   4334:                             ($trole,$tdom,$tnum,$tsec) = 
                   4335:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4336:                         } else {
                   4337:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4338:                         }
                   4339:                         my ($spec,$area,$trest);
                   4340:                         $area = '/'.$tdom.'/'.$tnum;
                   4341:                         $trest = $tnum;
                   4342:                         if ($tsec ne '') {
                   4343:                             $area .= '/'.$tsec;
                   4344:                             $trest .= '/'.$tsec;
                   4345:                         }
                   4346:                         $spec = $trole.'.'.$area;
                   4347:                         if ($trole =~ /^cr/) {
                   4348:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4349:                                                               $tdom,$spec,$trest,$area);
                   4350:                         } else {
                   4351:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4352:                                                                 $tdom,$spec,$trest,$area);
                   4353:                         }
                   4354:                     }
                   4355:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4356:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4357:                         if ($1) {
                   4358:                             $no_userblock = 1;
                   4359:                             last;
                   4360:                         }
1.486     raeburn  4361:                     }
                   4362:                 }
1.490     raeburn  4363:             } else {
                   4364:                 # Resource belongs to current user
                   4365:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4366:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4367:                     $no_ownblock = 1;
                   4368:                     last;
                   4369:                 }
1.474     raeburn  4370:             }
                   4371:         }
                   4372:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4373:         next if (($no_ownblock) &&
1.491     albertel 4374:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4375:         next if ($no_userblock);
1.474     raeburn  4376: 
1.866     kalberla 4377:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4378:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4379:         
1.1062    raeburn  4380:         my ($start,$end,$trigger) = 
                   4381:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4382:         if (($start != 0) && 
                   4383:             (($startblock == 0) || ($startblock > $start))) {
                   4384:             $startblock = $start;
1.1062    raeburn  4385:             if ($trigger ne '') {
                   4386:                 $triggerblock = $trigger;
                   4387:             }
1.502     raeburn  4388:         }
                   4389:         if (($end != 0)  &&
                   4390:             (($endblock == 0) || ($endblock < $end))) {
                   4391:             $endblock = $end;
1.1062    raeburn  4392:             if ($trigger ne '') {
                   4393:                 $triggerblock = $trigger;
                   4394:             }
1.502     raeburn  4395:         }
1.490     raeburn  4396:     }
1.1062    raeburn  4397:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4398: }
                   4399: 
                   4400: sub get_blocks {
1.1062    raeburn  4401:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4402:     my $startblock = 0;
                   4403:     my $endblock = 0;
1.1062    raeburn  4404:     my $triggerblock = '';
1.490     raeburn  4405:     my $course = $cdom.'_'.$cnum;
                   4406:     $setters->{$course} = {};
                   4407:     $setters->{$course}{'staff'} = [];
                   4408:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4409:     $setters->{$course}{'triggers'} = [];
                   4410:     my (@blockers,%triggered);
                   4411:     my $now = time;
                   4412:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4413:     if ($activity eq 'docs') {
                   4414:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4415:         foreach my $block (@blockers) {
                   4416:             if ($block =~ /^firstaccess____(.+)$/) {
                   4417:                 my $item = $1;
                   4418:                 my $type = 'map';
                   4419:                 my $timersymb = $item;
                   4420:                 if ($item eq 'course') {
                   4421:                     $type = 'course';
                   4422:                 } elsif ($item =~ /___\d+___/) {
                   4423:                     $type = 'resource';
                   4424:                 } else {
                   4425:                     $timersymb = &Apache::lonnet::symbread($item);
                   4426:                 }
                   4427:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4428:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4429:                 $triggered{$block} = {
                   4430:                                        start => $start,
                   4431:                                        end   => $end,
                   4432:                                        type  => $type,
                   4433:                                      };
                   4434:             }
                   4435:         }
                   4436:     } else {
                   4437:         foreach my $block (keys(%commblocks)) {
                   4438:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4439:                 my ($start,$end) = ($1,$2);
                   4440:                 if ($start <= time && $end >= time) {
                   4441:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4442:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4443:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4444:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4445:                                     push(@blockers,$block);
                   4446:                                 }
                   4447:                             }
                   4448:                         }
                   4449:                     }
                   4450:                 }
                   4451:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4452:                 my $item = $1;
                   4453:                 my $timersymb = $item; 
                   4454:                 my $type = 'map';
                   4455:                 if ($item eq 'course') {
                   4456:                     $type = 'course';
                   4457:                 } elsif ($item =~ /___\d+___/) {
                   4458:                     $type = 'resource';
                   4459:                 } else {
                   4460:                     $timersymb = &Apache::lonnet::symbread($item);
                   4461:                 }
                   4462:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4463:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4464:                 if ($start && $end) {
                   4465:                     if (($start <= time) && ($end >= time)) {
                   4466:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4467:                             push(@blockers,$block);
                   4468:                             $triggered{$block} = {
                   4469:                                                    start => $start,
                   4470:                                                    end   => $end,
                   4471:                                                    type  => $type,
                   4472:                                                  };
                   4473:                         }
                   4474:                     }
1.490     raeburn  4475:                 }
1.1062    raeburn  4476:             }
                   4477:         }
                   4478:     }
                   4479:     foreach my $blocker (@blockers) {
                   4480:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4481:             &parse_block_record($commblocks{$blocker});
                   4482:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4483:         my ($start,$end,$triggertype);
                   4484:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4485:             ($start,$end) = ($1,$2);
                   4486:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4487:             $start = $triggered{$blocker}{'start'};
                   4488:             $end = $triggered{$blocker}{'end'};
                   4489:             $triggertype = $triggered{$blocker}{'type'};
                   4490:         }
                   4491:         if ($start) {
                   4492:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4493:             if ($triggertype) {
                   4494:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4495:             } else {
                   4496:                 push(@{$$setters{$course}{'triggers'}},0);
                   4497:             }
                   4498:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4499:                 $startblock = $start;
                   4500:                 if ($triggertype) {
                   4501:                     $triggerblock = $blocker;
1.474     raeburn  4502:                 }
                   4503:             }
1.1062    raeburn  4504:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4505:                $endblock = $end;
                   4506:                if ($triggertype) {
                   4507:                    $triggerblock = $blocker;
                   4508:                }
                   4509:             }
1.474     raeburn  4510:         }
                   4511:     }
1.1062    raeburn  4512:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4513: }
                   4514: 
                   4515: sub parse_block_record {
                   4516:     my ($record) = @_;
                   4517:     my ($setuname,$setudom,$title,$blocks);
                   4518:     if (ref($record) eq 'HASH') {
                   4519:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4520:         $title = &unescape($record->{'event'});
                   4521:         $blocks = $record->{'blocks'};
                   4522:     } else {
                   4523:         my @data = split(/:/,$record,3);
                   4524:         if (scalar(@data) eq 2) {
                   4525:             $title = $data[1];
                   4526:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4527:         } else {
                   4528:             ($setuname,$setudom,$title) = @data;
                   4529:         }
                   4530:         $blocks = { 'com' => 'on' };
                   4531:     }
                   4532:     return ($setuname,$setudom,$title,$blocks);
                   4533: }
                   4534: 
1.854     kalberla 4535: sub blocking_status {
1.1075.2.73  raeburn  4536:     my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061    raeburn  4537:     my %setters;
1.890     droeschl 4538: 
1.1061    raeburn  4539: # check for active blocking
1.1062    raeburn  4540:     my ($startblock,$endblock,$triggerblock) = 
1.1075.2.73  raeburn  4541:         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062    raeburn  4542:     my $blocked = 0;
                   4543:     if ($startblock && $endblock) {
                   4544:         $blocked = 1;
                   4545:     }
1.890     droeschl 4546: 
1.1061    raeburn  4547: # caller just wants to know whether a block is active
                   4548:     if (!wantarray) { return $blocked; }
                   4549: 
                   4550: # build a link to a popup window containing the details
                   4551:     my $querystring  = "?activity=$activity";
                   4552: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4553:     if ($activity eq 'port') {
                   4554:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4555:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4556:     } elsif ($activity eq 'docs') {
                   4557:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4558:     }
1.1061    raeburn  4559: 
                   4560:     my $output .= <<'END_MYBLOCK';
                   4561: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4562:     var options = "width=" + w + ",height=" + h + ",";
                   4563:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4564:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4565:     var newWin = window.open(url, wdwName, options);
                   4566:     newWin.focus();
                   4567: }
1.890     droeschl 4568: END_MYBLOCK
1.854     kalberla 4569: 
1.1061    raeburn  4570:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4571:   
1.1061    raeburn  4572:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4573:     my $text = &mt('Communication Blocked');
                   4574:     if ($activity eq 'docs') {
                   4575:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4576:     } elsif ($activity eq 'printout') {
                   4577:         $text = &mt('Printing Blocked');
1.1062    raeburn  4578:     }
1.1061    raeburn  4579:     $output .= <<"END_BLOCK";
1.867     kalberla 4580: <div class='LC_comblock'>
1.869     kalberla 4581:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4582:   title='$text'>
                   4583:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4584:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4585:   title='$text'>$text</a>
1.867     kalberla 4586: </div>
                   4587: 
                   4588: END_BLOCK
1.474     raeburn  4589: 
1.1061    raeburn  4590:     return ($blocked, $output);
1.854     kalberla 4591: }
1.490     raeburn  4592: 
1.60      matthew  4593: ###############################################
                   4594: 
1.682     raeburn  4595: sub check_ip_acc {
                   4596:     my ($acc)=@_;
                   4597:     &Apache::lonxml::debug("acc is $acc");
                   4598:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4599:         return 1;
                   4600:     }
                   4601:     my $allowed=0;
                   4602:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4603: 
                   4604:     my $name;
                   4605:     foreach my $pattern (split(',',$acc)) {
                   4606:         $pattern =~ s/^\s*//;
                   4607:         $pattern =~ s/\s*$//;
                   4608:         if ($pattern =~ /\*$/) {
                   4609:             #35.8.*
                   4610:             $pattern=~s/\*//;
                   4611:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4612:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4613:             #35.8.3.[34-56]
                   4614:             my $low=$2;
                   4615:             my $high=$3;
                   4616:             $pattern=$1;
                   4617:             if ($ip =~ /^\Q$pattern\E/) {
                   4618:                 my $last=(split(/\./,$ip))[3];
                   4619:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4620:             }
                   4621:         } elsif ($pattern =~ /^\*/) {
                   4622:             #*.msu.edu
                   4623:             $pattern=~s/\*//;
                   4624:             if (!defined($name)) {
                   4625:                 use Socket;
                   4626:                 my $netaddr=inet_aton($ip);
                   4627:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4628:             }
                   4629:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4630:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4631:             #127.0.0.1
                   4632:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4633:         } else {
                   4634:             #some.name.com
                   4635:             if (!defined($name)) {
                   4636:                 use Socket;
                   4637:                 my $netaddr=inet_aton($ip);
                   4638:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4639:             }
                   4640:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4641:         }
                   4642:         if ($allowed) { last; }
                   4643:     }
                   4644:     return $allowed;
                   4645: }
                   4646: 
                   4647: ###############################################
                   4648: 
1.60      matthew  4649: =pod
                   4650: 
1.112     bowersj2 4651: =head1 Domain Template Functions
                   4652: 
                   4653: =over 4
                   4654: 
                   4655: =item * &determinedomain()
1.60      matthew  4656: 
                   4657: Inputs: $domain (usually will be undef)
                   4658: 
1.63      www      4659: Returns: Determines which domain should be used for designs
1.60      matthew  4660: 
                   4661: =cut
1.54      www      4662: 
1.60      matthew  4663: ###############################################
1.63      www      4664: sub determinedomain {
                   4665:     my $domain=shift;
1.531     albertel 4666:     if (! $domain) {
1.60      matthew  4667:         # Determine domain if we have not been given one
1.893     raeburn  4668:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4669:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4670:         if ($env{'request.role.domain'}) { 
                   4671:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4672:         }
                   4673:     }
1.63      www      4674:     return $domain;
                   4675: }
                   4676: ###############################################
1.517     raeburn  4677: 
1.518     albertel 4678: sub devalidate_domconfig_cache {
                   4679:     my ($udom)=@_;
                   4680:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4681: }
                   4682: 
                   4683: # ---------------------- Get domain configuration for a domain
                   4684: sub get_domainconf {
                   4685:     my ($udom) = @_;
                   4686:     my $cachetime=1800;
                   4687:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4688:     if (defined($cached)) { return %{$result}; }
                   4689: 
                   4690:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4691: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4692:     my (%designhash,%legacy);
1.518     albertel 4693:     if (keys(%domconfig) > 0) {
                   4694:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4695:             if (keys(%{$domconfig{'login'}})) {
                   4696:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4697:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4698:                         if ($key eq 'loginvia') {
                   4699:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4700:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4701:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4702:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4703:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4704:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4705:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4706: 
                   4707:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4708:                                             } else {
1.1013    raeburn  4709:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4710:                                             }
                   4711:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4712:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4713:                                             }
1.946     raeburn  4714:                                         }
                   4715:                                     }
                   4716:                                 }
                   4717:                             }
                   4718:                         } else {
                   4719:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4720:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4721:                                     $domconfig{'login'}{$key}{$img};
                   4722:                             }
1.699     raeburn  4723:                         }
                   4724:                     } else {
                   4725:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4726:                     }
1.632     raeburn  4727:                 }
                   4728:             } else {
                   4729:                 $legacy{'login'} = 1;
1.518     albertel 4730:             }
1.632     raeburn  4731:         } else {
                   4732:             $legacy{'login'} = 1;
1.518     albertel 4733:         }
                   4734:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4735:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4736:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4737:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4738:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4739:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4740:                         }
1.518     albertel 4741:                     }
                   4742:                 }
1.632     raeburn  4743:             } else {
                   4744:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4745:             }
1.632     raeburn  4746:         } else {
                   4747:             $legacy{'rolecolors'} = 1;
1.518     albertel 4748:         }
1.948     raeburn  4749:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4750:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4751:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4752:             }
                   4753:         }
1.632     raeburn  4754:         if (keys(%legacy) > 0) {
                   4755:             my %legacyhash = &get_legacy_domconf($udom);
                   4756:             foreach my $item (keys(%legacyhash)) {
                   4757:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4758:                     if ($legacy{'login'}) { 
                   4759:                         $designhash{$item} = $legacyhash{$item};
                   4760:                     }
                   4761:                 } else {
                   4762:                     if ($legacy{'rolecolors'}) {
                   4763:                         $designhash{$item} = $legacyhash{$item};
                   4764:                     }
1.518     albertel 4765:                 }
                   4766:             }
                   4767:         }
1.632     raeburn  4768:     } else {
                   4769:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4770:     }
                   4771:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4772: 				  $cachetime);
                   4773:     return %designhash;
                   4774: }
                   4775: 
1.632     raeburn  4776: sub get_legacy_domconf {
                   4777:     my ($udom) = @_;
                   4778:     my %legacyhash;
                   4779:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4780:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4781:     if (-e $designfile) {
                   4782:         if ( open (my $fh,"<$designfile") ) {
                   4783:             while (my $line = <$fh>) {
                   4784:                 next if ($line =~ /^\#/);
                   4785:                 chomp($line);
                   4786:                 my ($key,$val)=(split(/\=/,$line));
                   4787:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4788:             }
                   4789:             close($fh);
                   4790:         }
                   4791:     }
1.1026    raeburn  4792:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4793:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4794:     }
                   4795:     return %legacyhash;
                   4796: }
                   4797: 
1.63      www      4798: =pod
                   4799: 
1.112     bowersj2 4800: =item * &domainlogo()
1.63      www      4801: 
                   4802: Inputs: $domain (usually will be undef)
                   4803: 
                   4804: Returns: A link to a domain logo, if the domain logo exists.
                   4805: If the domain logo does not exist, a description of the domain.
                   4806: 
                   4807: =cut
1.112     bowersj2 4808: 
1.63      www      4809: ###############################################
                   4810: sub domainlogo {
1.517     raeburn  4811:     my $domain = &determinedomain(shift);
1.518     albertel 4812:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4813:     # See if there is a logo
                   4814:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4815:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4816:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4817: 	    if ($imgsrc =~ m{^/res/}) {
                   4818: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4819: 		&Apache::lonnet::repcopy($local_name);
                   4820: 	    }
                   4821: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4822:         } 
                   4823:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4824:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4825:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4826:     } else {
1.60      matthew  4827:         return '';
1.59      www      4828:     }
                   4829: }
1.63      www      4830: ##############################################
                   4831: 
                   4832: =pod
                   4833: 
1.112     bowersj2 4834: =item * &designparm()
1.63      www      4835: 
                   4836: Inputs: $which parameter; $domain (usually will be undef)
                   4837: 
                   4838: Returns: value of designparamter $which
                   4839: 
                   4840: =cut
1.112     bowersj2 4841: 
1.397     albertel 4842: 
1.400     albertel 4843: ##############################################
1.397     albertel 4844: sub designparm {
                   4845:     my ($which,$domain)=@_;
                   4846:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4847:         return $env{'environment.color.'.$which};
1.96      www      4848:     }
1.63      www      4849:     $domain=&determinedomain($domain);
1.1016    raeburn  4850:     my %domdesign;
                   4851:     unless ($domain eq 'public') {
                   4852:         %domdesign = &get_domainconf($domain);
                   4853:     }
1.520     raeburn  4854:     my $output;
1.517     raeburn  4855:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4856:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4857:     } else {
1.520     raeburn  4858:         $output = $defaultdesign{$which};
                   4859:     }
                   4860:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4861:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4862:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4863:             if ($output =~ m{^/res/}) {
                   4864:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4865:                 &Apache::lonnet::repcopy($local_name);
                   4866:             }
1.520     raeburn  4867:             $output = &lonhttpdurl($output);
                   4868:         }
1.63      www      4869:     }
1.520     raeburn  4870:     return $output;
1.63      www      4871: }
1.59      www      4872: 
1.822     bisitz   4873: ##############################################
                   4874: =pod
                   4875: 
1.832     bisitz   4876: =item * &authorspace()
                   4877: 
1.1028    raeburn  4878: Inputs: $url (usually will be undef).
1.832     bisitz   4879: 
1.1075.2.40  raeburn  4880: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  4881:          directory being viewed (or for which action is being taken). 
                   4882:          If $url is provided, and begins /priv/<domain>/<uname>
                   4883:          the path will be that portion of the $context argument.
                   4884:          Otherwise the path will be for the author space of the current
                   4885:          user when the current role is author, or for that of the 
                   4886:          co-author/assistant co-author space when the current role 
                   4887:          is co-author or assistant co-author.
1.832     bisitz   4888: 
                   4889: =cut
                   4890: 
                   4891: sub authorspace {
1.1028    raeburn  4892:     my ($url) = @_;
                   4893:     if ($url ne '') {
                   4894:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4895:            return $1;
                   4896:         }
                   4897:     }
1.832     bisitz   4898:     my $caname = '';
1.1024    www      4899:     my $cadom = '';
1.1028    raeburn  4900:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4901:         ($cadom,$caname) =
1.832     bisitz   4902:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4903:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4904:         $caname = $env{'user.name'};
1.1024    www      4905:         $cadom = $env{'user.domain'};
1.832     bisitz   4906:     }
1.1028    raeburn  4907:     if (($caname ne '') && ($cadom ne '')) {
                   4908:         return "/priv/$cadom/$caname/";
                   4909:     }
                   4910:     return;
1.832     bisitz   4911: }
                   4912: 
                   4913: ##############################################
                   4914: =pod
                   4915: 
1.822     bisitz   4916: =item * &head_subbox()
                   4917: 
                   4918: Inputs: $content (contains HTML code with page functions, etc.)
                   4919: 
                   4920: Returns: HTML div with $content
                   4921:          To be included in page header
                   4922: 
                   4923: =cut
                   4924: 
                   4925: sub head_subbox {
                   4926:     my ($content)=@_;
                   4927:     my $output =
1.993     raeburn  4928:         '<div class="LC_head_subbox">'
1.822     bisitz   4929:        .$content
                   4930:        .'</div>'
                   4931: }
                   4932: 
                   4933: ##############################################
                   4934: =pod
                   4935: 
                   4936: =item * &CSTR_pageheader()
                   4937: 
1.1026    raeburn  4938: Input: (optional) filename from which breadcrumb trail is built.
                   4939:        In most cases no input as needed, as $env{'request.filename'}
                   4940:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4941: 
                   4942: Returns: HTML div with CSTR path and recent box
1.1075.2.40  raeburn  4943:          To be included on Authoring Space pages
1.822     bisitz   4944: 
                   4945: =cut
                   4946: 
                   4947: sub CSTR_pageheader {
1.1026    raeburn  4948:     my ($trailfile) = @_;
                   4949:     if ($trailfile eq '') {
                   4950:         $trailfile = $env{'request.filename'};
                   4951:     }
                   4952: 
                   4953: # this is for resources; directories have customtitle, and crumbs
                   4954: # and select recent are created in lonpubdir.pm
                   4955: 
                   4956:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4957:     my ($udom,$uname,$thisdisfn)=
1.1075.2.29  raeburn  4958:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  4959:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4960:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4961: 
                   4962:     my $parentpath = '';
                   4963:     my $lastitem = '';
                   4964:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4965:         $parentpath = $1;
                   4966:         $lastitem = $2;
                   4967:     } else {
                   4968:         $lastitem = $thisdisfn;
                   4969:     }
1.921     bisitz   4970: 
                   4971:     my $output =
1.822     bisitz   4972:          '<div>'
                   4973:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40  raeburn  4974:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   4975:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4976:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4977:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4978: 
                   4979:     if ($lastitem) {
                   4980:         $output .=
                   4981:              '<span class="LC_filename">'
                   4982:             .$lastitem
                   4983:             .'</span>';
                   4984:     }
                   4985:     $output .=
                   4986:          '<br />'
1.822     bisitz   4987:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4988:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4989:         .'</form>'
                   4990:         .&Apache::lonmenu::constspaceform()
                   4991:         .'</div>';
1.921     bisitz   4992: 
                   4993:     return $output;
1.822     bisitz   4994: }
                   4995: 
1.60      matthew  4996: ###############################################
                   4997: ###############################################
                   4998: 
                   4999: =pod
                   5000: 
1.112     bowersj2 5001: =back
                   5002: 
1.549     albertel 5003: =head1 HTML Helpers
1.112     bowersj2 5004: 
                   5005: =over 4
                   5006: 
                   5007: =item * &bodytag()
1.60      matthew  5008: 
                   5009: Returns a uniform header for LON-CAPA web pages.
                   5010: 
                   5011: Inputs: 
                   5012: 
1.112     bowersj2 5013: =over 4
                   5014: 
                   5015: =item * $title, A title to be displayed on the page.
                   5016: 
                   5017: =item * $function, the current role (can be undef).
                   5018: 
                   5019: =item * $addentries, extra parameters for the <body> tag.
                   5020: 
                   5021: =item * $bodyonly, if defined, only return the <body> tag.
                   5022: 
                   5023: =item * $domain, if defined, force a given domain.
                   5024: 
                   5025: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5026:             text interface only)
1.60      matthew  5027: 
1.814     bisitz   5028: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5029:                      navigational links
1.317     albertel 5030: 
1.338     albertel 5031: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5032: 
1.1075.2.12  raeburn  5033: =item * $no_inline_link, if true and in remote mode, don't show the
                   5034:          'Switch To Inline Menu' link
                   5035: 
1.460     albertel 5036: =item * $args, optional argument valid values are
                   5037:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5038:             inherit_jsmath -> when creating popup window in a page,
                   5039:                               should it have jsmath forced on by the
                   5040:                               current page
1.460     albertel 5041: 
1.1075.2.15  raeburn  5042: =item * $advtoolsref, optional argument, ref to an array containing
                   5043:             inlineremote items to be added in "Functions" menu below
                   5044:             breadcrumbs.
                   5045: 
1.112     bowersj2 5046: =back
                   5047: 
1.60      matthew  5048: Returns: A uniform header for LON-CAPA web pages.  
                   5049: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5050: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5051: other decorations will be returned.
                   5052: 
                   5053: =cut
                   5054: 
1.54      www      5055: sub bodytag {
1.831     bisitz   5056:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15  raeburn  5057:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 5058: 
1.954     raeburn  5059:     my $public;
                   5060:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5061:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5062:         $public = 1;
                   5063:     }
1.460     albertel 5064:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52  raeburn  5065:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5066: 
1.183     matthew  5067:     $function = &get_users_function() if (!$function);
1.339     albertel 5068:     my $img =    &designparm($function.'.img',$domain);
                   5069:     my $font =   &designparm($function.'.font',$domain);
                   5070:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5071: 
1.803     bisitz   5072:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5073: 		   'bgcolor' => $pgbg,
1.339     albertel 5074: 		   'text'    => $font,
                   5075:                    'alink'   => &designparm($function.'.alink',$domain),
                   5076: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5077: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5078:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5079: 
1.63      www      5080:  # role and realm
1.1075.2.68  raeburn  5081:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5082:     if ($realm) {
                   5083:         $realm = '/'.$realm;
                   5084:     }
1.378     raeburn  5085:     if ($role  eq 'ca') {
1.479     albertel 5086:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5087:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5088:     } 
1.55      www      5089: # realm
1.258     albertel 5090:     if ($env{'request.course.id'}) {
1.378     raeburn  5091:         if ($env{'request.role'} !~ /^cr/) {
                   5092:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5093:         }
1.898     raeburn  5094:         if ($env{'request.course.sec'}) {
                   5095:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5096:         }   
1.359     albertel 5097: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5098:     } else {
                   5099:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5100:     }
1.433     albertel 5101: 
1.359     albertel 5102:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5103: 
1.438     albertel 5104:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5105: 
1.101     www      5106: # construct main body tag
1.359     albertel 5107:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5108: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5109: 
1.1075.2.38  raeburn  5110:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5111: 
                   5112:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5113:         return $bodytag;
1.1075.2.38  raeburn  5114:     }
1.359     albertel 5115: 
1.954     raeburn  5116:     if ($public) {
1.433     albertel 5117: 	undef($role);
                   5118:     }
1.359     albertel 5119:     
1.762     bisitz   5120:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5121:     #
                   5122:     # Extra info if you are the DC
                   5123:     my $dc_info = '';
                   5124:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5125:                         $env{'course.'.$env{'request.course.id'}.
                   5126:                                  '.domain'}.'/'})) {
                   5127:         my $cid = $env{'request.course.id'};
1.917     raeburn  5128:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5129:         $dc_info =~ s/\s+$//;
1.359     albertel 5130:     }
                   5131: 
1.898     raeburn  5132:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903     droeschl 5133: 
1.1075.2.13  raeburn  5134:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5135: 
1.1075.2.38  raeburn  5136: 
                   5137: 
1.1075.2.21  raeburn  5138:     my $funclist;
                   5139:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52  raeburn  5140:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21  raeburn  5141:                     Apache::lonmenu::serverform();
                   5142:         my $forbodytag;
                   5143:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5144:                                             $forcereg,$args->{'group'},
                   5145:                                             $args->{'bread_crumbs'},
                   5146:                                             $advtoolsref,'',\$forbodytag);
                   5147:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5148:             $funclist = $forbodytag;
                   5149:         }
                   5150:     } else {
1.903     droeschl 5151: 
                   5152:         #    if ($env{'request.state'} eq 'construct') {
                   5153:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5154:         #    }
                   5155: 
1.1075.2.38  raeburn  5156:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5157:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5158: 
1.1075.2.38  raeburn  5159:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2  raeburn  5160: 
1.916     droeschl 5161:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22  raeburn  5162:             if ($dc_info) {
                   5163:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5164:             }
1.1075.2.38  raeburn  5165:             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22  raeburn  5166:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5167:             return $bodytag;
                   5168:         }
1.894     droeschl 5169: 
1.927     raeburn  5170:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38  raeburn  5171:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5172:         }
1.916     droeschl 5173: 
1.1075.2.38  raeburn  5174:         $bodytag .= $right;
1.852     droeschl 5175: 
1.917     raeburn  5176:         if ($dc_info) {
                   5177:             $dc_info = &dc_courseid_toggle($dc_info);
                   5178:         }
                   5179:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5180: 
1.1075.2.61  raeburn  5181:         #if directed to not display the secondary menu, don't.
                   5182:         if ($args->{'no_secondary_menu'}) {
                   5183:             return $bodytag;
                   5184:         }
1.903     droeschl 5185:         #don't show menus for public users
1.954     raeburn  5186:         if (!$public){
1.1075.2.52  raeburn  5187:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5188:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5189:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5190:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5191:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5192:                                 $args->{'bread_crumbs'});
                   5193:             } elsif ($forcereg) { 
1.1075.2.22  raeburn  5194:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5195:                                                             $args->{'group'});
1.1075.2.15  raeburn  5196:             } else {
1.1075.2.21  raeburn  5197:                 my $forbodytag;
                   5198:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5199:                                                     $forcereg,$args->{'group'},
                   5200:                                                     $args->{'bread_crumbs'},
                   5201:                                                     $advtoolsref,'',\$forbodytag);
                   5202:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5203:                     $bodytag .= $forbodytag;
                   5204:                 }
1.920     raeburn  5205:             }
1.903     droeschl 5206:         }else{
                   5207:             # this is to seperate menu from content when there's no secondary
                   5208:             # menu. Especially needed for public accessible ressources.
                   5209:             $bodytag .= '<hr style="clear:both" />';
                   5210:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5211:         }
1.903     droeschl 5212: 
1.235     raeburn  5213:         return $bodytag;
1.1075.2.12  raeburn  5214:     }
                   5215: 
                   5216: #
                   5217: # Top frame rendering, Remote is up
                   5218: #
                   5219: 
                   5220:     my $imgsrc = $img;
                   5221:     if ($img =~ /^\/adm/) {
                   5222:         $imgsrc = &lonhttpdurl($img);
                   5223:     }
                   5224:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5225: 
1.1075.2.60  raeburn  5226:     my $help=($no_inline_link?''
                   5227:               :&Apache::loncommon::top_nav_help('Help'));
                   5228: 
1.1075.2.12  raeburn  5229:     # Explicit link to get inline menu
                   5230:     my $menu= ($no_inline_link?''
                   5231:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5232: 
                   5233:     if ($dc_info) {
                   5234:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5235:     }
                   5236: 
1.1075.2.38  raeburn  5237:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
                   5238:     unless ($public) {
                   5239:         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5240:                                 undef,'LC_menubuttons_link');
                   5241:     }
                   5242: 
1.1075.2.12  raeburn  5243:     unless ($env{'form.inhibitmenu'}) {
                   5244:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38  raeburn  5245:                        <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60  raeburn  5246:                        <li>$help</li>
1.1075.2.12  raeburn  5247:                        <li>$menu</li>
                   5248:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5249:     }
1.1075.2.13  raeburn  5250:     if ($env{'request.state'} eq 'construct') {
                   5251:         if (!$public){
                   5252:             if ($env{'request.state'} eq 'construct') {
                   5253:                 $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5254:                                 &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13  raeburn  5255:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5256:                             &Apache::lonmenu::innerregister($forcereg,
                   5257:                                                             $args->{'bread_crumbs'});
                   5258:             }
                   5259:         }
                   5260:     }
1.1075.2.21  raeburn  5261:     return $bodytag."\n".$funclist;
1.182     matthew  5262: }
                   5263: 
1.917     raeburn  5264: sub dc_courseid_toggle {
                   5265:     my ($dc_info) = @_;
1.980     raeburn  5266:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5267:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5268:            &mt('(More ...)').'</a></span>'.
                   5269:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5270: }
                   5271: 
1.330     albertel 5272: sub make_attr_string {
                   5273:     my ($register,$attr_ref) = @_;
                   5274: 
                   5275:     if ($attr_ref && !ref($attr_ref)) {
                   5276: 	die("addentries Must be a hash ref ".
                   5277: 	    join(':',caller(1))." ".
                   5278: 	    join(':',caller(0))." ");
                   5279:     }
                   5280: 
                   5281:     if ($register) {
1.339     albertel 5282: 	my ($on_load,$on_unload);
                   5283: 	foreach my $key (keys(%{$attr_ref})) {
                   5284: 	    if      (lc($key) eq 'onload') {
                   5285: 		$on_load.=$attr_ref->{$key}.';';
                   5286: 		delete($attr_ref->{$key});
                   5287: 
                   5288: 	    } elsif (lc($key) eq 'onunload') {
                   5289: 		$on_unload.=$attr_ref->{$key}.';';
                   5290: 		delete($attr_ref->{$key});
                   5291: 	    }
                   5292: 	}
1.1075.2.12  raeburn  5293:         if ($env{'environment.remote'} eq 'on') {
                   5294:             $attr_ref->{'onload'}  =
                   5295:                 &Apache::lonmenu::loadevents().  $on_load;
                   5296:             $attr_ref->{'onunload'}=
                   5297:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5298:         } else {  
                   5299: 	    $attr_ref->{'onload'}  = $on_load;
                   5300: 	    $attr_ref->{'onunload'}= $on_unload;
                   5301:         }
1.330     albertel 5302:     }
1.339     albertel 5303: 
1.330     albertel 5304:     my $attr_string;
1.1075.2.56  raeburn  5305:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5306: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5307:     }
                   5308:     return $attr_string;
                   5309: }
                   5310: 
                   5311: 
1.182     matthew  5312: ###############################################
1.251     albertel 5313: ###############################################
                   5314: 
                   5315: =pod
                   5316: 
                   5317: =item * &endbodytag()
                   5318: 
                   5319: Returns a uniform footer for LON-CAPA web pages.
                   5320: 
1.635     raeburn  5321: Inputs: 1 - optional reference to an args hash
                   5322: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5323: a 'Continue' link is not displayed if the page contains an
                   5324: internal redirect in the <head></head> section,
                   5325: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5326: 
                   5327: =cut
                   5328: 
                   5329: sub endbodytag {
1.635     raeburn  5330:     my ($args) = @_;
1.1075.2.6  raeburn  5331:     my $endbodytag;
                   5332:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5333:         $endbodytag='</body>';
                   5334:     }
1.269     albertel 5335:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5336:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5337:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5338: 	    $endbodytag=
                   5339: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5340: 	        &mt('Continue').'</a>'.
                   5341: 	        $endbodytag;
                   5342:         }
1.315     albertel 5343:     }
1.251     albertel 5344:     return $endbodytag;
                   5345: }
                   5346: 
1.352     albertel 5347: =pod
                   5348: 
                   5349: =item * &standard_css()
                   5350: 
                   5351: Returns a style sheet
                   5352: 
                   5353: Inputs: (all optional)
                   5354:             domain         -> force to color decorate a page for a specific
                   5355:                                domain
                   5356:             function       -> force usage of a specific rolish color scheme
                   5357:             bgcolor        -> override the default page bgcolor
                   5358: 
                   5359: =cut
                   5360: 
1.343     albertel 5361: sub standard_css {
1.345     albertel 5362:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5363:     $function  = &get_users_function() if (!$function);
                   5364:     my $img    = &designparm($function.'.img',   $domain);
                   5365:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5366:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5367:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5368: #second colour for later usage
1.345     albertel 5369:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5370:     my $pgbg_or_bgcolor =
                   5371: 	         $bgcolor ||
1.352     albertel 5372: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5373:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5374:     my $alink  = &designparm($function.'.alink', $domain);
                   5375:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5376:     my $link   = &designparm($function.'.link',  $domain);
                   5377: 
1.602     albertel 5378:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5379:     my $mono                 = 'monospace';
1.850     bisitz   5380:     my $data_table_head      = $sidebg;
                   5381:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5382:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5383:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5384:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5385:     my $mail_new             = '#FFBB77';
                   5386:     my $mail_new_hover       = '#DD9955';
                   5387:     my $mail_read            = '#BBBB77';
                   5388:     my $mail_read_hover      = '#999944';
                   5389:     my $mail_replied         = '#AAAA88';
                   5390:     my $mail_replied_hover   = '#888855';
                   5391:     my $mail_other           = '#99BBBB';
                   5392:     my $mail_other_hover     = '#669999';
1.391     albertel 5393:     my $table_header         = '#DDDDDD';
1.489     raeburn  5394:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5395:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5396:     my $button_hover         = '#BF2317';
1.392     albertel 5397: 
1.608     albertel 5398:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5399:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5400:                                              : '0 3px 0 4px';
1.448     albertel 5401: 
1.523     albertel 5402: 
1.343     albertel 5403:     return <<END;
1.947     droeschl 5404: 
                   5405: /* needed for iframe to allow 100% height in FF */
                   5406: body, html { 
                   5407:     margin: 0;
                   5408:     padding: 0 0.5%;
                   5409:     height: 99%; /* to avoid scrollbars */
                   5410: }
                   5411: 
1.795     www      5412: body {
1.911     bisitz   5413:   font-family: $sans;
                   5414:   line-height:130%;
                   5415:   font-size:0.83em;
                   5416:   color:$font;
1.795     www      5417: }
                   5418: 
1.959     onken    5419: a:focus,
                   5420: a:focus img {
1.795     www      5421:   color: red;
                   5422: }
1.698     harmsja  5423: 
1.911     bisitz   5424: form, .inline {
                   5425:   display: inline;
1.795     www      5426: }
1.721     harmsja  5427: 
1.795     www      5428: .LC_right {
1.911     bisitz   5429:   text-align:right;
1.795     www      5430: }
                   5431: 
                   5432: .LC_middle {
1.911     bisitz   5433:   vertical-align:middle;
1.795     www      5434: }
1.721     harmsja  5435: 
1.1075.2.38  raeburn  5436: .LC_floatleft {
                   5437:   float: left;
                   5438: }
                   5439: 
                   5440: .LC_floatright {
                   5441:   float: right;
                   5442: }
                   5443: 
1.911     bisitz   5444: .LC_400Box {
                   5445:   width:400px;
                   5446: }
1.721     harmsja  5447: 
1.947     droeschl 5448: .LC_iframecontainer {
                   5449:     width: 98%;
                   5450:     margin: 0;
                   5451:     position: fixed;
                   5452:     top: 8.5em;
                   5453:     bottom: 0;
                   5454: }
                   5455: 
                   5456: .LC_iframecontainer iframe{
                   5457:     border: none;
                   5458:     width: 100%;
                   5459:     height: 100%;
                   5460: }
                   5461: 
1.778     bisitz   5462: .LC_filename {
                   5463:   font-family: $mono;
                   5464:   white-space:pre;
1.921     bisitz   5465:   font-size: 120%;
1.778     bisitz   5466: }
                   5467: 
                   5468: .LC_fileicon {
                   5469:   border: none;
                   5470:   height: 1.3em;
                   5471:   vertical-align: text-bottom;
                   5472:   margin-right: 0.3em;
                   5473:   text-decoration:none;
                   5474: }
                   5475: 
1.1008    www      5476: .LC_setting {
                   5477:   text-decoration:underline;
                   5478: }
                   5479: 
1.350     albertel 5480: .LC_error {
                   5481:   color: red;
                   5482: }
1.795     www      5483: 
1.1075.2.15  raeburn  5484: .LC_warning {
                   5485:   color: darkorange;
                   5486: }
                   5487: 
1.457     albertel 5488: .LC_diff_removed {
1.733     bisitz   5489:   color: red;
1.394     albertel 5490: }
1.532     albertel 5491: 
                   5492: .LC_info,
1.457     albertel 5493: .LC_success,
                   5494: .LC_diff_added {
1.350     albertel 5495:   color: green;
                   5496: }
1.795     www      5497: 
1.802     bisitz   5498: div.LC_confirm_box {
                   5499:   background-color: #FAFAFA;
                   5500:   border: 1px solid $lg_border_color;
                   5501:   margin-right: 0;
                   5502:   padding: 5px;
                   5503: }
                   5504: 
                   5505: div.LC_confirm_box .LC_error img,
                   5506: div.LC_confirm_box .LC_success img {
                   5507:   vertical-align: middle;
                   5508: }
                   5509: 
1.440     albertel 5510: .LC_icon {
1.771     droeschl 5511:   border: none;
1.790     droeschl 5512:   vertical-align: middle;
1.771     droeschl 5513: }
                   5514: 
1.543     albertel 5515: .LC_docs_spacer {
                   5516:   width: 25px;
                   5517:   height: 1px;
1.771     droeschl 5518:   border: none;
1.543     albertel 5519: }
1.346     albertel 5520: 
1.532     albertel 5521: .LC_internal_info {
1.735     bisitz   5522:   color: #999999;
1.532     albertel 5523: }
                   5524: 
1.794     www      5525: .LC_discussion {
1.1050    www      5526:   background: $data_table_dark;
1.911     bisitz   5527:   border: 1px solid black;
                   5528:   margin: 2px;
1.794     www      5529: }
                   5530: 
                   5531: .LC_disc_action_left {
1.1050    www      5532:   background: $sidebg;
1.911     bisitz   5533:   text-align: left;
1.1050    www      5534:   padding: 4px;
                   5535:   margin: 2px;
1.794     www      5536: }
                   5537: 
                   5538: .LC_disc_action_right {
1.1050    www      5539:   background: $sidebg;
1.911     bisitz   5540:   text-align: right;
1.1050    www      5541:   padding: 4px;
                   5542:   margin: 2px;
1.794     www      5543: }
                   5544: 
                   5545: .LC_disc_new_item {
1.911     bisitz   5546:   background: white;
                   5547:   border: 2px solid red;
1.1050    www      5548:   margin: 4px;
                   5549:   padding: 4px;
1.794     www      5550: }
                   5551: 
                   5552: .LC_disc_old_item {
1.911     bisitz   5553:   background: white;
1.1050    www      5554:   margin: 4px;
                   5555:   padding: 4px;
1.794     www      5556: }
                   5557: 
1.458     albertel 5558: table.LC_pastsubmission {
                   5559:   border: 1px solid black;
                   5560:   margin: 2px;
                   5561: }
                   5562: 
1.924     bisitz   5563: table#LC_menubuttons {
1.345     albertel 5564:   width: 100%;
                   5565:   background: $pgbg;
1.392     albertel 5566:   border: 2px;
1.402     albertel 5567:   border-collapse: separate;
1.803     bisitz   5568:   padding: 0;
1.345     albertel 5569: }
1.392     albertel 5570: 
1.801     tempelho 5571: table#LC_title_bar a {
                   5572:   color: $fontmenu;
                   5573: }
1.836     bisitz   5574: 
1.807     droeschl 5575: table#LC_title_bar {
1.819     tempelho 5576:   clear: both;
1.836     bisitz   5577:   display: none;
1.807     droeschl 5578: }
                   5579: 
1.795     www      5580: table#LC_title_bar,
1.933     droeschl 5581: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5582: table#LC_title_bar.LC_with_remote {
1.359     albertel 5583:   width: 100%;
1.392     albertel 5584:   border-color: $pgbg;
                   5585:   border-style: solid;
                   5586:   border-width: $border;
1.379     albertel 5587:   background: $pgbg;
1.801     tempelho 5588:   color: $fontmenu;
1.392     albertel 5589:   border-collapse: collapse;
1.803     bisitz   5590:   padding: 0;
1.819     tempelho 5591:   margin: 0;
1.359     albertel 5592: }
1.795     www      5593: 
1.933     droeschl 5594: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5595:     margin: 0;
                   5596:     padding: 0;
1.933     droeschl 5597:     position: relative;
                   5598:     list-style: none;
1.913     droeschl 5599: }
1.933     droeschl 5600: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5601:     display: inline;
                   5602: }
1.933     droeschl 5603: 
                   5604: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5605:     padding: 0;
1.933     droeschl 5606:     margin: 0;
                   5607:     float: left;
1.913     droeschl 5608: }
1.933     droeschl 5609: .LC_breadcrumb_tools_tools {
                   5610:     padding: 0;
                   5611:     margin: 0;
1.913     droeschl 5612:     float: right;
                   5613: }
                   5614: 
1.359     albertel 5615: table#LC_title_bar td {
                   5616:   background: $tabbg;
                   5617: }
1.795     www      5618: 
1.911     bisitz   5619: table#LC_menubuttons img {
1.803     bisitz   5620:   border: none;
1.346     albertel 5621: }
1.795     www      5622: 
1.842     droeschl 5623: .LC_breadcrumbs_component {
1.911     bisitz   5624:   float: right;
                   5625:   margin: 0 1em;
1.357     albertel 5626: }
1.842     droeschl 5627: .LC_breadcrumbs_component img {
1.911     bisitz   5628:   vertical-align: middle;
1.777     tempelho 5629: }
1.795     www      5630: 
1.383     albertel 5631: td.LC_table_cell_checkbox {
                   5632:   text-align: center;
                   5633: }
1.795     www      5634: 
                   5635: .LC_fontsize_small {
1.911     bisitz   5636:   font-size: 70%;
1.705     tempelho 5637: }
                   5638: 
1.844     bisitz   5639: #LC_breadcrumbs {
1.911     bisitz   5640:   clear:both;
                   5641:   background: $sidebg;
                   5642:   border-bottom: 1px solid $lg_border_color;
                   5643:   line-height: 2.5em;
1.933     droeschl 5644:   overflow: hidden;
1.911     bisitz   5645:   margin: 0;
                   5646:   padding: 0;
1.995     raeburn  5647:   text-align: left;
1.819     tempelho 5648: }
1.862     bisitz   5649: 
1.1075.2.16  raeburn  5650: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5651:   clear:both;
                   5652:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5653:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  5654:   margin: 0 0 10px 0;
1.966     bisitz   5655:   padding: 3px;
1.995     raeburn  5656:   text-align: left;
1.822     bisitz   5657: }
                   5658: 
1.795     www      5659: .LC_fontsize_medium {
1.911     bisitz   5660:   font-size: 85%;
1.705     tempelho 5661: }
                   5662: 
1.795     www      5663: .LC_fontsize_large {
1.911     bisitz   5664:   font-size: 120%;
1.705     tempelho 5665: }
                   5666: 
1.346     albertel 5667: .LC_menubuttons_inline_text {
                   5668:   color: $font;
1.698     harmsja  5669:   font-size: 90%;
1.701     harmsja  5670:   padding-left:3px;
1.346     albertel 5671: }
                   5672: 
1.934     droeschl 5673: .LC_menubuttons_inline_text img{
                   5674:   vertical-align: middle;
                   5675: }
                   5676: 
1.1051    www      5677: li.LC_menubuttons_inline_text img {
1.951     onken    5678:   cursor:pointer;
1.1002    droeschl 5679:   text-decoration: none;
1.951     onken    5680: }
                   5681: 
1.526     www      5682: .LC_menubuttons_link {
                   5683:   text-decoration: none;
                   5684: }
1.795     www      5685: 
1.522     albertel 5686: .LC_menubuttons_category {
1.521     www      5687:   color: $font;
1.526     www      5688:   background: $pgbg;
1.521     www      5689:   font-size: larger;
                   5690:   font-weight: bold;
                   5691: }
                   5692: 
1.346     albertel 5693: td.LC_menubuttons_text {
1.911     bisitz   5694:   color: $font;
1.346     albertel 5695: }
1.706     harmsja  5696: 
1.346     albertel 5697: .LC_current_location {
                   5698:   background: $tabbg;
                   5699: }
1.795     www      5700: 
1.938     bisitz   5701: table.LC_data_table {
1.347     albertel 5702:   border: 1px solid #000000;
1.402     albertel 5703:   border-collapse: separate;
1.426     albertel 5704:   border-spacing: 1px;
1.610     albertel 5705:   background: $pgbg;
1.347     albertel 5706: }
1.795     www      5707: 
1.422     albertel 5708: .LC_data_table_dense {
                   5709:   font-size: small;
                   5710: }
1.795     www      5711: 
1.507     raeburn  5712: table.LC_nested_outer {
                   5713:   border: 1px solid #000000;
1.589     raeburn  5714:   border-collapse: collapse;
1.803     bisitz   5715:   border-spacing: 0;
1.507     raeburn  5716:   width: 100%;
                   5717: }
1.795     www      5718: 
1.879     raeburn  5719: table.LC_innerpickbox,
1.507     raeburn  5720: table.LC_nested {
1.803     bisitz   5721:   border: none;
1.589     raeburn  5722:   border-collapse: collapse;
1.803     bisitz   5723:   border-spacing: 0;
1.507     raeburn  5724:   width: 100%;
                   5725: }
1.795     www      5726: 
1.911     bisitz   5727: table.LC_data_table tr th,
                   5728: table.LC_calendar tr th,
1.879     raeburn  5729: table.LC_prior_tries tr th,
                   5730: table.LC_innerpickbox tr th {
1.349     albertel 5731:   font-weight: bold;
                   5732:   background-color: $data_table_head;
1.801     tempelho 5733:   color:$fontmenu;
1.701     harmsja  5734:   font-size:90%;
1.347     albertel 5735: }
1.795     www      5736: 
1.879     raeburn  5737: table.LC_innerpickbox tr th,
                   5738: table.LC_innerpickbox tr td {
                   5739:   vertical-align: top;
                   5740: }
                   5741: 
1.711     raeburn  5742: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5743:   background-color: #CCCCCC;
1.711     raeburn  5744:   font-weight: bold;
                   5745:   text-align: left;
                   5746: }
1.795     www      5747: 
1.912     bisitz   5748: table.LC_data_table tr.LC_odd_row > td {
                   5749:   background-color: $data_table_light;
                   5750:   padding: 2px;
                   5751:   vertical-align: top;
                   5752: }
                   5753: 
1.809     bisitz   5754: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5755:   background-color: $data_table_light;
1.912     bisitz   5756:   vertical-align: top;
                   5757: }
                   5758: 
                   5759: table.LC_data_table tr.LC_even_row > td {
                   5760:   background-color: $data_table_dark;
1.425     albertel 5761:   padding: 2px;
1.900     bisitz   5762:   vertical-align: top;
1.347     albertel 5763: }
1.795     www      5764: 
1.809     bisitz   5765: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5766:   background-color: $data_table_dark;
1.900     bisitz   5767:   vertical-align: top;
1.347     albertel 5768: }
1.795     www      5769: 
1.425     albertel 5770: table.LC_data_table tr.LC_data_table_highlight td {
                   5771:   background-color: $data_table_darker;
                   5772: }
1.795     www      5773: 
1.639     raeburn  5774: table.LC_data_table tr td.LC_leftcol_header {
                   5775:   background-color: $data_table_head;
                   5776:   font-weight: bold;
                   5777: }
1.795     www      5778: 
1.451     albertel 5779: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5780: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5781:   font-weight: bold;
                   5782:   font-style: italic;
                   5783:   text-align: center;
                   5784:   padding: 8px;
1.347     albertel 5785: }
1.795     www      5786: 
1.1075.2.30  raeburn  5787: table.LC_data_table tr.LC_empty_row td,
                   5788: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   5789:   background-color: $sidebg;
                   5790: }
                   5791: 
                   5792: table.LC_nested tr.LC_empty_row td {
                   5793:   background-color: #FFFFFF;
                   5794: }
                   5795: 
1.890     droeschl 5796: table.LC_caption {
                   5797: }
                   5798: 
1.507     raeburn  5799: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5800:   padding: 4ex
                   5801: }
1.795     www      5802: 
1.507     raeburn  5803: table.LC_nested_outer tr th {
                   5804:   font-weight: bold;
1.801     tempelho 5805:   color:$fontmenu;
1.507     raeburn  5806:   background-color: $data_table_head;
1.701     harmsja  5807:   font-size: small;
1.507     raeburn  5808:   border-bottom: 1px solid #000000;
                   5809: }
1.795     www      5810: 
1.507     raeburn  5811: table.LC_nested_outer tr td.LC_subheader {
                   5812:   background-color: $data_table_head;
                   5813:   font-weight: bold;
                   5814:   font-size: small;
                   5815:   border-bottom: 1px solid #000000;
                   5816:   text-align: right;
1.451     albertel 5817: }
1.795     www      5818: 
1.507     raeburn  5819: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5820:   background-color: #CCCCCC;
1.451     albertel 5821:   font-weight: bold;
                   5822:   font-size: small;
1.507     raeburn  5823:   text-align: center;
                   5824: }
1.795     www      5825: 
1.589     raeburn  5826: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5827: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5828:   text-align: left;
1.451     albertel 5829: }
1.795     www      5830: 
1.507     raeburn  5831: table.LC_nested td {
1.735     bisitz   5832:   background-color: #FFFFFF;
1.451     albertel 5833:   font-size: small;
1.507     raeburn  5834: }
1.795     www      5835: 
1.507     raeburn  5836: table.LC_nested_outer tr th.LC_right_item,
                   5837: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5838: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5839: table.LC_nested tr td.LC_right_item {
1.451     albertel 5840:   text-align: right;
                   5841: }
                   5842: 
1.507     raeburn  5843: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5844:   background-color: #EEEEEE;
1.451     albertel 5845: }
                   5846: 
1.473     raeburn  5847: table.LC_createuser {
                   5848: }
                   5849: 
                   5850: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5851:   font-size: small;
1.473     raeburn  5852: }
                   5853: 
                   5854: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5855:   background-color: #CCCCCC;
1.473     raeburn  5856:   font-weight: bold;
                   5857:   text-align: center;
                   5858: }
                   5859: 
1.349     albertel 5860: table.LC_calendar {
                   5861:   border: 1px solid #000000;
                   5862:   border-collapse: collapse;
1.917     raeburn  5863:   width: 98%;
1.349     albertel 5864: }
1.795     www      5865: 
1.349     albertel 5866: table.LC_calendar_pickdate {
                   5867:   font-size: xx-small;
                   5868: }
1.795     www      5869: 
1.349     albertel 5870: table.LC_calendar tr td {
                   5871:   border: 1px solid #000000;
                   5872:   vertical-align: top;
1.917     raeburn  5873:   width: 14%;
1.349     albertel 5874: }
1.795     www      5875: 
1.349     albertel 5876: table.LC_calendar tr td.LC_calendar_day_empty {
                   5877:   background-color: $data_table_dark;
                   5878: }
1.795     www      5879: 
1.779     bisitz   5880: table.LC_calendar tr td.LC_calendar_day_current {
                   5881:   background-color: $data_table_highlight;
1.777     tempelho 5882: }
1.795     www      5883: 
1.938     bisitz   5884: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5885:   background-color: $mail_new;
                   5886: }
1.795     www      5887: 
1.938     bisitz   5888: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5889:   background-color: $mail_new_hover;
                   5890: }
1.795     www      5891: 
1.938     bisitz   5892: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5893:   background-color: $mail_read;
                   5894: }
1.795     www      5895: 
1.938     bisitz   5896: /*
                   5897: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5898:   background-color: $mail_read_hover;
                   5899: }
1.938     bisitz   5900: */
1.795     www      5901: 
1.938     bisitz   5902: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5903:   background-color: $mail_replied;
                   5904: }
1.795     www      5905: 
1.938     bisitz   5906: /*
                   5907: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5908:   background-color: $mail_replied_hover;
                   5909: }
1.938     bisitz   5910: */
1.795     www      5911: 
1.938     bisitz   5912: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5913:   background-color: $mail_other;
                   5914: }
1.795     www      5915: 
1.938     bisitz   5916: /*
                   5917: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5918:   background-color: $mail_other_hover;
                   5919: }
1.938     bisitz   5920: */
1.494     raeburn  5921: 
1.777     tempelho 5922: table.LC_data_table tr > td.LC_browser_file,
                   5923: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5924:   background: #AAEE77;
1.389     albertel 5925: }
1.795     www      5926: 
1.777     tempelho 5927: table.LC_data_table tr > td.LC_browser_file_locked,
                   5928: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5929:   background: #FFAA99;
1.387     albertel 5930: }
1.795     www      5931: 
1.777     tempelho 5932: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5933:   background: #888888;
1.779     bisitz   5934: }
1.795     www      5935: 
1.777     tempelho 5936: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5937: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5938:   background: #F8F866;
1.777     tempelho 5939: }
1.795     www      5940: 
1.696     bisitz   5941: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5942:   background: #E0E8FF;
1.387     albertel 5943: }
1.696     bisitz   5944: 
1.707     bisitz   5945: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5946:   /* background: #77FF77; */
1.707     bisitz   5947: }
1.795     www      5948: 
1.707     bisitz   5949: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5950:   border-right: 8px solid #FFFF77;
1.707     bisitz   5951: }
1.795     www      5952: 
1.707     bisitz   5953: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5954:   border-right: 8px solid #FFAA77;
1.707     bisitz   5955: }
1.795     www      5956: 
1.707     bisitz   5957: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5958:   border-right: 8px solid #FF7777;
1.707     bisitz   5959: }
1.795     www      5960: 
1.707     bisitz   5961: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5962:   border-right: 8px solid #AAFF77;
1.707     bisitz   5963: }
1.795     www      5964: 
1.707     bisitz   5965: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5966:   border-right: 8px solid #11CC55;
1.707     bisitz   5967: }
                   5968: 
1.388     albertel 5969: span.LC_current_location {
1.701     harmsja  5970:   font-size:larger;
1.388     albertel 5971:   background: $pgbg;
                   5972: }
1.387     albertel 5973: 
1.1029    www      5974: span.LC_current_nav_location {
                   5975:   font-weight:bold;
                   5976:   background: $sidebg;
                   5977: }
                   5978: 
1.395     albertel 5979: span.LC_parm_menu_item {
                   5980:   font-size: larger;
                   5981: }
1.795     www      5982: 
1.395     albertel 5983: span.LC_parm_scope_all {
                   5984:   color: red;
                   5985: }
1.795     www      5986: 
1.395     albertel 5987: span.LC_parm_scope_folder {
                   5988:   color: green;
                   5989: }
1.795     www      5990: 
1.395     albertel 5991: span.LC_parm_scope_resource {
                   5992:   color: orange;
                   5993: }
1.795     www      5994: 
1.395     albertel 5995: span.LC_parm_part {
                   5996:   color: blue;
                   5997: }
1.795     www      5998: 
1.911     bisitz   5999: span.LC_parm_folder,
                   6000: span.LC_parm_symb {
1.395     albertel 6001:   font-size: x-small;
                   6002:   font-family: $mono;
                   6003:   color: #AAAAAA;
                   6004: }
                   6005: 
1.977     bisitz   6006: ul.LC_parm_parmlist li {
                   6007:   display: inline-block;
                   6008:   padding: 0.3em 0.8em;
                   6009:   vertical-align: top;
                   6010:   width: 150px;
                   6011:   border-top:1px solid $lg_border_color;
                   6012: }
                   6013: 
1.795     www      6014: td.LC_parm_overview_level_menu,
                   6015: td.LC_parm_overview_map_menu,
                   6016: td.LC_parm_overview_parm_selectors,
                   6017: td.LC_parm_overview_restrictions  {
1.396     albertel 6018:   border: 1px solid black;
                   6019:   border-collapse: collapse;
                   6020: }
1.795     www      6021: 
1.396     albertel 6022: table.LC_parm_overview_restrictions td {
                   6023:   border-width: 1px 4px 1px 4px;
                   6024:   border-style: solid;
                   6025:   border-color: $pgbg;
                   6026:   text-align: center;
                   6027: }
1.795     www      6028: 
1.396     albertel 6029: table.LC_parm_overview_restrictions th {
                   6030:   background: $tabbg;
                   6031:   border-width: 1px 4px 1px 4px;
                   6032:   border-style: solid;
                   6033:   border-color: $pgbg;
                   6034: }
1.795     www      6035: 
1.398     albertel 6036: table#LC_helpmenu {
1.803     bisitz   6037:   border: none;
1.398     albertel 6038:   height: 55px;
1.803     bisitz   6039:   border-spacing: 0;
1.398     albertel 6040: }
                   6041: 
                   6042: table#LC_helpmenu fieldset legend {
                   6043:   font-size: larger;
                   6044: }
1.795     www      6045: 
1.397     albertel 6046: table#LC_helpmenu_links {
                   6047:   width: 100%;
                   6048:   border: 1px solid black;
                   6049:   background: $pgbg;
1.803     bisitz   6050:   padding: 0;
1.397     albertel 6051:   border-spacing: 1px;
                   6052: }
1.795     www      6053: 
1.397     albertel 6054: table#LC_helpmenu_links tr td {
                   6055:   padding: 1px;
                   6056:   background: $tabbg;
1.399     albertel 6057:   text-align: center;
                   6058:   font-weight: bold;
1.397     albertel 6059: }
1.396     albertel 6060: 
1.795     www      6061: table#LC_helpmenu_links a:link,
                   6062: table#LC_helpmenu_links a:visited,
1.397     albertel 6063: table#LC_helpmenu_links a:active {
                   6064:   text-decoration: none;
                   6065:   color: $font;
                   6066: }
1.795     www      6067: 
1.397     albertel 6068: table#LC_helpmenu_links a:hover {
                   6069:   text-decoration: underline;
                   6070:   color: $vlink;
                   6071: }
1.396     albertel 6072: 
1.417     albertel 6073: .LC_chrt_popup_exists {
                   6074:   border: 1px solid #339933;
                   6075:   margin: -1px;
                   6076: }
1.795     www      6077: 
1.417     albertel 6078: .LC_chrt_popup_up {
                   6079:   border: 1px solid yellow;
                   6080:   margin: -1px;
                   6081: }
1.795     www      6082: 
1.417     albertel 6083: .LC_chrt_popup {
                   6084:   border: 1px solid #8888FF;
                   6085:   background: #CCCCFF;
                   6086: }
1.795     www      6087: 
1.421     albertel 6088: table.LC_pick_box {
                   6089:   border-collapse: separate;
                   6090:   background: white;
                   6091:   border: 1px solid black;
                   6092:   border-spacing: 1px;
                   6093: }
1.795     www      6094: 
1.421     albertel 6095: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6096:   background: $sidebg;
1.421     albertel 6097:   font-weight: bold;
1.900     bisitz   6098:   text-align: left;
1.740     bisitz   6099:   vertical-align: top;
1.421     albertel 6100:   width: 184px;
                   6101:   padding: 8px;
                   6102: }
1.795     www      6103: 
1.579     raeburn  6104: table.LC_pick_box td.LC_pick_box_value {
                   6105:   text-align: left;
                   6106:   padding: 8px;
                   6107: }
1.795     www      6108: 
1.579     raeburn  6109: table.LC_pick_box td.LC_pick_box_select {
                   6110:   text-align: left;
                   6111:   padding: 8px;
                   6112: }
1.795     www      6113: 
1.424     albertel 6114: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6115:   padding: 0;
1.421     albertel 6116:   height: 1px;
                   6117:   background: black;
                   6118: }
1.795     www      6119: 
1.421     albertel 6120: table.LC_pick_box td.LC_pick_box_submit {
                   6121:   text-align: right;
                   6122: }
1.795     www      6123: 
1.579     raeburn  6124: table.LC_pick_box td.LC_evenrow_value {
                   6125:   text-align: left;
                   6126:   padding: 8px;
                   6127:   background-color: $data_table_light;
                   6128: }
1.795     www      6129: 
1.579     raeburn  6130: table.LC_pick_box td.LC_oddrow_value {
                   6131:   text-align: left;
                   6132:   padding: 8px;
                   6133:   background-color: $data_table_light;
                   6134: }
1.795     www      6135: 
1.579     raeburn  6136: span.LC_helpform_receipt_cat {
                   6137:   font-weight: bold;
                   6138: }
1.795     www      6139: 
1.424     albertel 6140: table.LC_group_priv_box {
                   6141:   background: white;
                   6142:   border: 1px solid black;
                   6143:   border-spacing: 1px;
                   6144: }
1.795     www      6145: 
1.424     albertel 6146: table.LC_group_priv_box td.LC_pick_box_title {
                   6147:   background: $tabbg;
                   6148:   font-weight: bold;
                   6149:   text-align: right;
                   6150:   width: 184px;
                   6151: }
1.795     www      6152: 
1.424     albertel 6153: table.LC_group_priv_box td.LC_groups_fixed {
                   6154:   background: $data_table_light;
                   6155:   text-align: center;
                   6156: }
1.795     www      6157: 
1.424     albertel 6158: table.LC_group_priv_box td.LC_groups_optional {
                   6159:   background: $data_table_dark;
                   6160:   text-align: center;
                   6161: }
1.795     www      6162: 
1.424     albertel 6163: table.LC_group_priv_box td.LC_groups_functionality {
                   6164:   background: $data_table_darker;
                   6165:   text-align: center;
                   6166:   font-weight: bold;
                   6167: }
1.795     www      6168: 
1.424     albertel 6169: table.LC_group_priv td {
                   6170:   text-align: left;
1.803     bisitz   6171:   padding: 0;
1.424     albertel 6172: }
                   6173: 
                   6174: .LC_navbuttons {
                   6175:   margin: 2ex 0ex 2ex 0ex;
                   6176: }
1.795     www      6177: 
1.423     albertel 6178: .LC_topic_bar {
                   6179:   font-weight: bold;
                   6180:   background: $tabbg;
1.918     wenzelju 6181:   margin: 1em 0em 1em 2em;
1.805     bisitz   6182:   padding: 3px;
1.918     wenzelju 6183:   font-size: 1.2em;
1.423     albertel 6184: }
1.795     www      6185: 
1.423     albertel 6186: .LC_topic_bar span {
1.918     wenzelju 6187:   left: 0.5em;
                   6188:   position: absolute;
1.423     albertel 6189:   vertical-align: middle;
1.918     wenzelju 6190:   font-size: 1.2em;
1.423     albertel 6191: }
1.795     www      6192: 
1.423     albertel 6193: table.LC_course_group_status {
                   6194:   margin: 20px;
                   6195: }
1.795     www      6196: 
1.423     albertel 6197: table.LC_status_selector td {
                   6198:   vertical-align: top;
                   6199:   text-align: center;
1.424     albertel 6200:   padding: 4px;
                   6201: }
1.795     www      6202: 
1.599     albertel 6203: div.LC_feedback_link {
1.616     albertel 6204:   clear: both;
1.829     kalberla 6205:   background: $sidebg;
1.779     bisitz   6206:   width: 100%;
1.829     kalberla 6207:   padding-bottom: 10px;
                   6208:   border: 1px $tabbg solid;
1.833     kalberla 6209:   height: 22px;
                   6210:   line-height: 22px;
                   6211:   padding-top: 5px;
                   6212: }
                   6213: 
                   6214: div.LC_feedback_link img {
                   6215:   height: 22px;
1.867     kalberla 6216:   vertical-align:middle;
1.829     kalberla 6217: }
                   6218: 
1.911     bisitz   6219: div.LC_feedback_link a {
1.829     kalberla 6220:   text-decoration: none;
1.489     raeburn  6221: }
1.795     www      6222: 
1.867     kalberla 6223: div.LC_comblock {
1.911     bisitz   6224:   display:inline;
1.867     kalberla 6225:   color:$font;
                   6226:   font-size:90%;
                   6227: }
                   6228: 
                   6229: div.LC_feedback_link div.LC_comblock {
                   6230:   padding-left:5px;
                   6231: }
                   6232: 
                   6233: div.LC_feedback_link div.LC_comblock a {
                   6234:   color:$font;
                   6235: }
                   6236: 
1.489     raeburn  6237: span.LC_feedback_link {
1.858     bisitz   6238:   /* background: $feedback_link_bg; */
1.599     albertel 6239:   font-size: larger;
                   6240: }
1.795     www      6241: 
1.599     albertel 6242: span.LC_message_link {
1.858     bisitz   6243:   /* background: $feedback_link_bg; */
1.599     albertel 6244:   font-size: larger;
                   6245:   position: absolute;
                   6246:   right: 1em;
1.489     raeburn  6247: }
1.421     albertel 6248: 
1.515     albertel 6249: table.LC_prior_tries {
1.524     albertel 6250:   border: 1px solid #000000;
                   6251:   border-collapse: separate;
                   6252:   border-spacing: 1px;
1.515     albertel 6253: }
1.523     albertel 6254: 
1.515     albertel 6255: table.LC_prior_tries td {
1.524     albertel 6256:   padding: 2px;
1.515     albertel 6257: }
1.523     albertel 6258: 
                   6259: .LC_answer_correct {
1.795     www      6260:   background: lightgreen;
                   6261:   color: darkgreen;
                   6262:   padding: 6px;
1.523     albertel 6263: }
1.795     www      6264: 
1.523     albertel 6265: .LC_answer_charged_try {
1.797     www      6266:   background: #FFAAAA;
1.795     www      6267:   color: darkred;
                   6268:   padding: 6px;
1.523     albertel 6269: }
1.795     www      6270: 
1.779     bisitz   6271: .LC_answer_not_charged_try,
1.523     albertel 6272: .LC_answer_no_grade,
                   6273: .LC_answer_late {
1.795     www      6274:   background: lightyellow;
1.523     albertel 6275:   color: black;
1.795     www      6276:   padding: 6px;
1.523     albertel 6277: }
1.795     www      6278: 
1.523     albertel 6279: .LC_answer_previous {
1.795     www      6280:   background: lightblue;
                   6281:   color: darkblue;
                   6282:   padding: 6px;
1.523     albertel 6283: }
1.795     www      6284: 
1.779     bisitz   6285: .LC_answer_no_message {
1.777     tempelho 6286:   background: #FFFFFF;
                   6287:   color: black;
1.795     www      6288:   padding: 6px;
1.779     bisitz   6289: }
1.795     www      6290: 
1.779     bisitz   6291: .LC_answer_unknown {
                   6292:   background: orange;
                   6293:   color: black;
1.795     www      6294:   padding: 6px;
1.777     tempelho 6295: }
1.795     www      6296: 
1.529     albertel 6297: span.LC_prior_numerical,
                   6298: span.LC_prior_string,
                   6299: span.LC_prior_custom,
                   6300: span.LC_prior_reaction,
                   6301: span.LC_prior_math {
1.925     bisitz   6302:   font-family: $mono;
1.523     albertel 6303:   white-space: pre;
                   6304: }
                   6305: 
1.525     albertel 6306: span.LC_prior_string {
1.925     bisitz   6307:   font-family: $mono;
1.525     albertel 6308:   white-space: pre;
                   6309: }
                   6310: 
1.523     albertel 6311: table.LC_prior_option {
                   6312:   width: 100%;
                   6313:   border-collapse: collapse;
                   6314: }
1.795     www      6315: 
1.911     bisitz   6316: table.LC_prior_rank,
1.795     www      6317: table.LC_prior_match {
1.528     albertel 6318:   border-collapse: collapse;
                   6319: }
1.795     www      6320: 
1.528     albertel 6321: table.LC_prior_option tr td,
                   6322: table.LC_prior_rank tr td,
                   6323: table.LC_prior_match tr td {
1.524     albertel 6324:   border: 1px solid #000000;
1.515     albertel 6325: }
                   6326: 
1.855     bisitz   6327: .LC_nobreak {
1.544     albertel 6328:   white-space: nowrap;
1.519     raeburn  6329: }
                   6330: 
1.576     raeburn  6331: span.LC_cusr_emph {
                   6332:   font-style: italic;
                   6333: }
                   6334: 
1.633     raeburn  6335: span.LC_cusr_subheading {
                   6336:   font-weight: normal;
                   6337:   font-size: 85%;
                   6338: }
                   6339: 
1.861     bisitz   6340: div.LC_docs_entry_move {
1.859     bisitz   6341:   border: 1px solid #BBBBBB;
1.545     albertel 6342:   background: #DDDDDD;
1.861     bisitz   6343:   width: 22px;
1.859     bisitz   6344:   padding: 1px;
                   6345:   margin: 0;
1.545     albertel 6346: }
                   6347: 
1.861     bisitz   6348: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6349: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6350:   font-size: x-small;
                   6351: }
1.795     www      6352: 
1.861     bisitz   6353: .LC_docs_entry_parameter {
                   6354:   white-space: nowrap;
                   6355: }
                   6356: 
1.544     albertel 6357: .LC_docs_copy {
1.545     albertel 6358:   color: #000099;
1.544     albertel 6359: }
1.795     www      6360: 
1.544     albertel 6361: .LC_docs_cut {
1.545     albertel 6362:   color: #550044;
1.544     albertel 6363: }
1.795     www      6364: 
1.544     albertel 6365: .LC_docs_rename {
1.545     albertel 6366:   color: #009900;
1.544     albertel 6367: }
1.795     www      6368: 
1.544     albertel 6369: .LC_docs_remove {
1.545     albertel 6370:   color: #990000;
                   6371: }
                   6372: 
1.547     albertel 6373: .LC_docs_reinit_warn,
                   6374: .LC_docs_ext_edit {
                   6375:   font-size: x-small;
                   6376: }
                   6377: 
1.545     albertel 6378: table.LC_docs_adddocs td,
                   6379: table.LC_docs_adddocs th {
                   6380:   border: 1px solid #BBBBBB;
                   6381:   padding: 4px;
                   6382:   background: #DDDDDD;
1.543     albertel 6383: }
                   6384: 
1.584     albertel 6385: table.LC_sty_begin {
                   6386:   background: #BBFFBB;
                   6387: }
1.795     www      6388: 
1.584     albertel 6389: table.LC_sty_end {
                   6390:   background: #FFBBBB;
                   6391: }
                   6392: 
1.589     raeburn  6393: table.LC_double_column {
1.803     bisitz   6394:   border-width: 0;
1.589     raeburn  6395:   border-collapse: collapse;
                   6396:   width: 100%;
                   6397:   padding: 2px;
                   6398: }
                   6399: 
                   6400: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6401:   top: 2px;
1.589     raeburn  6402:   left: 2px;
                   6403:   width: 47%;
                   6404:   vertical-align: top;
                   6405: }
                   6406: 
                   6407: table.LC_double_column tr td.LC_right_col {
                   6408:   top: 2px;
1.779     bisitz   6409:   right: 2px;
1.589     raeburn  6410:   width: 47%;
                   6411:   vertical-align: top;
                   6412: }
                   6413: 
1.591     raeburn  6414: div.LC_left_float {
                   6415:   float: left;
                   6416:   padding-right: 5%;
1.597     albertel 6417:   padding-bottom: 4px;
1.591     raeburn  6418: }
                   6419: 
                   6420: div.LC_clear_float_header {
1.597     albertel 6421:   padding-bottom: 2px;
1.591     raeburn  6422: }
                   6423: 
                   6424: div.LC_clear_float_footer {
1.597     albertel 6425:   padding-top: 10px;
1.591     raeburn  6426:   clear: both;
                   6427: }
                   6428: 
1.597     albertel 6429: div.LC_grade_show_user {
1.941     bisitz   6430: /*  border-left: 5px solid $sidebg; */
                   6431:   border-top: 5px solid #000000;
                   6432:   margin: 50px 0 0 0;
1.936     bisitz   6433:   padding: 15px 0 5px 10px;
1.597     albertel 6434: }
1.795     www      6435: 
1.936     bisitz   6436: div.LC_grade_show_user_odd_row {
1.941     bisitz   6437: /*  border-left: 5px solid #000000; */
                   6438: }
                   6439: 
                   6440: div.LC_grade_show_user div.LC_Box {
                   6441:   margin-right: 50px;
1.597     albertel 6442: }
                   6443: 
                   6444: div.LC_grade_submissions,
                   6445: div.LC_grade_message_center,
1.936     bisitz   6446: div.LC_grade_info_links {
1.597     albertel 6447:   margin: 5px;
                   6448:   width: 99%;
                   6449:   background: #FFFFFF;
                   6450: }
1.795     www      6451: 
1.597     albertel 6452: div.LC_grade_submissions_header,
1.936     bisitz   6453: div.LC_grade_message_center_header {
1.705     tempelho 6454:   font-weight: bold;
                   6455:   font-size: large;
1.597     albertel 6456: }
1.795     www      6457: 
1.597     albertel 6458: div.LC_grade_submissions_body,
1.936     bisitz   6459: div.LC_grade_message_center_body {
1.597     albertel 6460:   border: 1px solid black;
                   6461:   width: 99%;
                   6462:   background: #FFFFFF;
                   6463: }
1.795     www      6464: 
1.613     albertel 6465: table.LC_scantron_action {
                   6466:   width: 100%;
                   6467: }
1.795     www      6468: 
1.613     albertel 6469: table.LC_scantron_action tr th {
1.698     harmsja  6470:   font-weight:bold;
                   6471:   font-style:normal;
1.613     albertel 6472: }
1.795     www      6473: 
1.779     bisitz   6474: .LC_edit_problem_header,
1.614     albertel 6475: div.LC_edit_problem_footer {
1.705     tempelho 6476:   font-weight: normal;
                   6477:   font-size:  medium;
1.602     albertel 6478:   margin: 2px;
1.1060    bisitz   6479:   background-color: $sidebg;
1.600     albertel 6480: }
1.795     www      6481: 
1.600     albertel 6482: div.LC_edit_problem_header,
1.602     albertel 6483: div.LC_edit_problem_header div,
1.614     albertel 6484: div.LC_edit_problem_footer,
                   6485: div.LC_edit_problem_footer div,
1.602     albertel 6486: div.LC_edit_problem_editxml_header,
                   6487: div.LC_edit_problem_editxml_header div {
1.600     albertel 6488:   margin-top: 5px;
                   6489: }
1.795     www      6490: 
1.600     albertel 6491: div.LC_edit_problem_header_title {
1.705     tempelho 6492:   font-weight: bold;
                   6493:   font-size: larger;
1.602     albertel 6494:   background: $tabbg;
                   6495:   padding: 3px;
1.1060    bisitz   6496:   margin: 0 0 5px 0;
1.602     albertel 6497: }
1.795     www      6498: 
1.602     albertel 6499: table.LC_edit_problem_header_title {
                   6500:   width: 100%;
1.600     albertel 6501:   background: $tabbg;
1.602     albertel 6502: }
                   6503: 
                   6504: div.LC_edit_problem_discards {
                   6505:   float: left;
                   6506:   padding-bottom: 5px;
                   6507: }
1.795     www      6508: 
1.602     albertel 6509: div.LC_edit_problem_saves {
                   6510:   float: right;
                   6511:   padding-bottom: 5px;
1.600     albertel 6512: }
1.795     www      6513: 
1.1075.2.34  raeburn  6514: .LC_edit_opt {
                   6515:   padding-left: 1em;
                   6516:   white-space: nowrap;
                   6517: }
                   6518: 
1.1075.2.57  raeburn  6519: .LC_edit_problem_latexhelper{
                   6520:     text-align: right;
                   6521: }
                   6522: 
                   6523: #LC_edit_problem_colorful div{
                   6524:     margin-left: 40px;
                   6525: }
                   6526: 
1.911     bisitz   6527: img.stift {
1.803     bisitz   6528:   border-width: 0;
                   6529:   vertical-align: middle;
1.677     riegler  6530: }
1.680     riegler  6531: 
1.923     bisitz   6532: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6533:   vertical-align: top;
1.777     tempelho 6534: }
1.795     www      6535: 
1.716     raeburn  6536: div.LC_createcourse {
1.911     bisitz   6537:   margin: 10px 10px 10px 10px;
1.716     raeburn  6538: }
                   6539: 
1.917     raeburn  6540: .LC_dccid {
1.1075.2.38  raeburn  6541:   float: right;
1.917     raeburn  6542:   margin: 0.2em 0 0 0;
                   6543:   padding: 0;
                   6544:   font-size: 90%;
                   6545:   display:none;
                   6546: }
                   6547: 
1.897     wenzelju 6548: ol.LC_primary_menu a:hover,
1.721     harmsja  6549: ol#LC_MenuBreadcrumbs a:hover,
                   6550: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6551: ul#LC_secondary_menu a:hover,
1.721     harmsja  6552: .LC_FormSectionClearButton input:hover
1.795     www      6553: ul.LC_TabContent   li:hover a {
1.952     onken    6554:   color:$button_hover;
1.911     bisitz   6555:   text-decoration:none;
1.693     droeschl 6556: }
                   6557: 
1.779     bisitz   6558: h1 {
1.911     bisitz   6559:   padding: 0;
                   6560:   line-height:130%;
1.693     droeschl 6561: }
1.698     harmsja  6562: 
1.911     bisitz   6563: h2,
                   6564: h3,
                   6565: h4,
                   6566: h5,
                   6567: h6 {
                   6568:   margin: 5px 0 5px 0;
                   6569:   padding: 0;
                   6570:   line-height:130%;
1.693     droeschl 6571: }
1.795     www      6572: 
                   6573: .LC_hcell {
1.911     bisitz   6574:   padding:3px 15px 3px 15px;
                   6575:   margin: 0;
                   6576:   background-color:$tabbg;
                   6577:   color:$fontmenu;
                   6578:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6579: }
1.795     www      6580: 
1.840     bisitz   6581: .LC_Box > .LC_hcell {
1.911     bisitz   6582:   margin: 0 -10px 10px -10px;
1.835     bisitz   6583: }
                   6584: 
1.721     harmsja  6585: .LC_noBorder {
1.911     bisitz   6586:   border: 0;
1.698     harmsja  6587: }
1.693     droeschl 6588: 
1.721     harmsja  6589: .LC_FormSectionClearButton input {
1.911     bisitz   6590:   background-color:transparent;
                   6591:   border: none;
                   6592:   cursor:pointer;
                   6593:   text-decoration:underline;
1.693     droeschl 6594: }
1.763     bisitz   6595: 
                   6596: .LC_help_open_topic {
1.911     bisitz   6597:   color: #FFFFFF;
                   6598:   background-color: #EEEEFF;
                   6599:   margin: 1px;
                   6600:   padding: 4px;
                   6601:   border: 1px solid #000033;
                   6602:   white-space: nowrap;
                   6603:   /* vertical-align: middle; */
1.759     neumanie 6604: }
1.693     droeschl 6605: 
1.911     bisitz   6606: dl,
                   6607: ul,
                   6608: div,
                   6609: fieldset {
                   6610:   margin: 10px 10px 10px 0;
                   6611:   /* overflow: hidden; */
1.693     droeschl 6612: }
1.795     www      6613: 
1.838     bisitz   6614: fieldset > legend {
1.911     bisitz   6615:   font-weight: bold;
                   6616:   padding: 0 5px 0 5px;
1.838     bisitz   6617: }
                   6618: 
1.813     bisitz   6619: #LC_nav_bar {
1.911     bisitz   6620:   float: left;
1.995     raeburn  6621:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6622:   margin: 0 0 2px 0;
1.807     droeschl 6623: }
                   6624: 
1.916     droeschl 6625: #LC_realm {
                   6626:   margin: 0.2em 0 0 0;
                   6627:   padding: 0;
                   6628:   font-weight: bold;
                   6629:   text-align: center;
1.995     raeburn  6630:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6631: }
                   6632: 
1.911     bisitz   6633: #LC_nav_bar em {
                   6634:   font-weight: bold;
                   6635:   font-style: normal;
1.807     droeschl 6636: }
                   6637: 
1.897     wenzelju 6638: ol.LC_primary_menu {
1.934     droeschl 6639:   margin: 0;
1.1075.2.2  raeburn  6640:   padding: 0;
1.995     raeburn  6641:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6642: }
                   6643: 
1.852     droeschl 6644: ol#LC_PathBreadcrumbs {
1.911     bisitz   6645:   margin: 0;
1.693     droeschl 6646: }
                   6647: 
1.897     wenzelju 6648: ol.LC_primary_menu li {
1.1075.2.2  raeburn  6649:   color: RGB(80, 80, 80);
                   6650:   vertical-align: middle;
                   6651:   text-align: left;
                   6652:   list-style: none;
                   6653:   float: left;
                   6654: }
                   6655: 
                   6656: ol.LC_primary_menu li a {
                   6657:   display: block;
                   6658:   margin: 0;
                   6659:   padding: 0 5px 0 10px;
                   6660:   text-decoration: none;
                   6661: }
                   6662: 
                   6663: ol.LC_primary_menu li ul {
                   6664:   display: none;
                   6665:   width: 10em;
                   6666:   background-color: $data_table_light;
                   6667: }
                   6668: 
                   6669: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6670:   display: block;
                   6671:   position: absolute;
                   6672:   margin: 0;
                   6673:   padding: 0;
1.1075.2.5  raeburn  6674:   z-index: 2;
1.1075.2.2  raeburn  6675: }
                   6676: 
                   6677: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6678:   font-size: 90%;
1.911     bisitz   6679:   vertical-align: top;
1.1075.2.2  raeburn  6680:   float: none;
1.1075.2.5  raeburn  6681:   border-left: 1px solid black;
                   6682:   border-right: 1px solid black;
1.1075.2.2  raeburn  6683: }
                   6684: 
                   6685: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5  raeburn  6686:   background-color:$data_table_light;
1.1075.2.2  raeburn  6687: }
                   6688: 
                   6689: ol.LC_primary_menu li li a:hover {
                   6690:    color:$button_hover;
                   6691:    background-color:$data_table_dark;
1.693     droeschl 6692: }
                   6693: 
1.897     wenzelju 6694: ol.LC_primary_menu li img {
1.911     bisitz   6695:   vertical-align: bottom;
1.934     droeschl 6696:   height: 1.1em;
1.1075.2.3  raeburn  6697:   margin: 0.2em 0 0 0;
1.693     droeschl 6698: }
                   6699: 
1.897     wenzelju 6700: ol.LC_primary_menu a {
1.911     bisitz   6701:   color: RGB(80, 80, 80);
                   6702:   text-decoration: none;
1.693     droeschl 6703: }
1.795     www      6704: 
1.949     droeschl 6705: ol.LC_primary_menu a.LC_new_message {
                   6706:   font-weight:bold;
                   6707:   color: darkred;
                   6708: }
                   6709: 
1.975     raeburn  6710: ol.LC_docs_parameters {
                   6711:   margin-left: 0;
                   6712:   padding: 0;
                   6713:   list-style: none;
                   6714: }
                   6715: 
                   6716: ol.LC_docs_parameters li {
                   6717:   margin: 0;
                   6718:   padding-right: 20px;
                   6719:   display: inline;
                   6720: }
                   6721: 
1.976     raeburn  6722: ol.LC_docs_parameters li:before {
                   6723:   content: "\\002022 \\0020";
                   6724: }
                   6725: 
                   6726: li.LC_docs_parameters_title {
                   6727:   font-weight: bold;
                   6728: }
                   6729: 
                   6730: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6731:   content: "";
                   6732: }
                   6733: 
1.897     wenzelju 6734: ul#LC_secondary_menu {
1.1075.2.23  raeburn  6735:   clear: right;
1.911     bisitz   6736:   color: $fontmenu;
                   6737:   background: $tabbg;
                   6738:   list-style: none;
                   6739:   padding: 0;
                   6740:   margin: 0;
                   6741:   width: 100%;
1.995     raeburn  6742:   text-align: left;
1.1075.2.4  raeburn  6743:   float: left;
1.808     droeschl 6744: }
                   6745: 
1.897     wenzelju 6746: ul#LC_secondary_menu li {
1.911     bisitz   6747:   font-weight: bold;
                   6748:   line-height: 1.8em;
                   6749:   border-right: 1px solid black;
                   6750:   vertical-align: middle;
1.1075.2.4  raeburn  6751:   float: left;
                   6752: }
                   6753: 
                   6754: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6755:   background-color: $data_table_light;
                   6756: }
                   6757: 
                   6758: ul#LC_secondary_menu li a {
                   6759:   padding: 0 0.8em;
                   6760: }
                   6761: 
                   6762: ul#LC_secondary_menu li ul {
                   6763:   display: none;
                   6764: }
                   6765: 
                   6766: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6767:   display: block;
                   6768:   position: absolute;
                   6769:   margin: 0;
                   6770:   padding: 0;
                   6771:   list-style:none;
                   6772:   float: none;
                   6773:   background-color: $data_table_light;
1.1075.2.5  raeburn  6774:   z-index: 2;
1.1075.2.10  raeburn  6775:   margin-left: -1px;
1.1075.2.4  raeburn  6776: }
                   6777: 
                   6778: ul#LC_secondary_menu li ul li {
                   6779:   font-size: 90%;
                   6780:   vertical-align: top;
                   6781:   border-left: 1px solid black;
                   6782:   border-right: 1px solid black;
1.1075.2.33  raeburn  6783:   background-color: $data_table_light;
1.1075.2.4  raeburn  6784:   list-style:none;
                   6785:   float: none;
                   6786: }
                   6787: 
                   6788: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6789:   background-color: $data_table_dark;
1.807     droeschl 6790: }
                   6791: 
1.847     tempelho 6792: ul.LC_TabContent {
1.911     bisitz   6793:   display:block;
                   6794:   background: $sidebg;
                   6795:   border-bottom: solid 1px $lg_border_color;
                   6796:   list-style:none;
1.1020    raeburn  6797:   margin: -1px -10px 0 -10px;
1.911     bisitz   6798:   padding: 0;
1.693     droeschl 6799: }
                   6800: 
1.795     www      6801: ul.LC_TabContent li,
                   6802: ul.LC_TabContentBigger li {
1.911     bisitz   6803:   float:left;
1.741     harmsja  6804: }
1.795     www      6805: 
1.897     wenzelju 6806: ul#LC_secondary_menu li a {
1.911     bisitz   6807:   color: $fontmenu;
                   6808:   text-decoration: none;
1.693     droeschl 6809: }
1.795     www      6810: 
1.721     harmsja  6811: ul.LC_TabContent {
1.952     onken    6812:   min-height:20px;
1.721     harmsja  6813: }
1.795     www      6814: 
                   6815: ul.LC_TabContent li {
1.911     bisitz   6816:   vertical-align:middle;
1.959     onken    6817:   padding: 0 16px 0 10px;
1.911     bisitz   6818:   background-color:$tabbg;
                   6819:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6820:   border-left: solid 1px $font;
1.721     harmsja  6821: }
1.795     www      6822: 
1.847     tempelho 6823: ul.LC_TabContent .right {
1.911     bisitz   6824:   float:right;
1.847     tempelho 6825: }
                   6826: 
1.911     bisitz   6827: ul.LC_TabContent li a,
                   6828: ul.LC_TabContent li {
                   6829:   color:rgb(47,47,47);
                   6830:   text-decoration:none;
                   6831:   font-size:95%;
                   6832:   font-weight:bold;
1.952     onken    6833:   min-height:20px;
                   6834: }
                   6835: 
1.959     onken    6836: ul.LC_TabContent li a:hover,
                   6837: ul.LC_TabContent li a:focus {
1.952     onken    6838:   color: $button_hover;
1.959     onken    6839:   background:none;
                   6840:   outline:none;
1.952     onken    6841: }
                   6842: 
                   6843: ul.LC_TabContent li:hover {
                   6844:   color: $button_hover;
                   6845:   cursor:pointer;
1.721     harmsja  6846: }
1.795     www      6847: 
1.911     bisitz   6848: ul.LC_TabContent li.active {
1.952     onken    6849:   color: $font;
1.911     bisitz   6850:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6851:   border-bottom:solid 1px #FFFFFF;
                   6852:   cursor: default;
1.744     ehlerst  6853: }
1.795     www      6854: 
1.959     onken    6855: ul.LC_TabContent li.active a {
                   6856:   color:$font;
                   6857:   background:#FFFFFF;
                   6858:   outline: none;
                   6859: }
1.1047    raeburn  6860: 
                   6861: ul.LC_TabContent li.goback {
                   6862:   float: left;
                   6863:   border-left: none;
                   6864: }
                   6865: 
1.870     tempelho 6866: #maincoursedoc {
1.911     bisitz   6867:   clear:both;
1.870     tempelho 6868: }
                   6869: 
                   6870: ul.LC_TabContentBigger {
1.911     bisitz   6871:   display:block;
                   6872:   list-style:none;
                   6873:   padding: 0;
1.870     tempelho 6874: }
                   6875: 
1.795     www      6876: ul.LC_TabContentBigger li {
1.911     bisitz   6877:   vertical-align:bottom;
                   6878:   height: 30px;
                   6879:   font-size:110%;
                   6880:   font-weight:bold;
                   6881:   color: #737373;
1.841     tempelho 6882: }
                   6883: 
1.957     onken    6884: ul.LC_TabContentBigger li.active {
                   6885:   position: relative;
                   6886:   top: 1px;
                   6887: }
                   6888: 
1.870     tempelho 6889: ul.LC_TabContentBigger li a {
1.911     bisitz   6890:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6891:   height: 30px;
                   6892:   line-height: 30px;
                   6893:   text-align: center;
                   6894:   display: block;
                   6895:   text-decoration: none;
1.958     onken    6896:   outline: none;  
1.741     harmsja  6897: }
1.795     www      6898: 
1.870     tempelho 6899: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6900:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6901:   color:$font;
1.744     ehlerst  6902: }
1.795     www      6903: 
1.870     tempelho 6904: ul.LC_TabContentBigger li b {
1.911     bisitz   6905:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6906:   display: block;
                   6907:   float: left;
                   6908:   padding: 0 30px;
1.957     onken    6909:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6910: }
                   6911: 
1.956     onken    6912: ul.LC_TabContentBigger li:hover b {
                   6913:   color:$button_hover;
                   6914: }
                   6915: 
1.870     tempelho 6916: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6917:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6918:   color:$font;
1.957     onken    6919:   border: 0;
1.741     harmsja  6920: }
1.693     droeschl 6921: 
1.870     tempelho 6922: 
1.862     bisitz   6923: ul.LC_CourseBreadcrumbs {
                   6924:   background: $sidebg;
1.1020    raeburn  6925:   height: 2em;
1.862     bisitz   6926:   padding-left: 10px;
1.1020    raeburn  6927:   margin: 0;
1.862     bisitz   6928:   list-style-position: inside;
                   6929: }
                   6930: 
1.911     bisitz   6931: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6932: ol#LC_PathBreadcrumbs {
1.911     bisitz   6933:   padding-left: 10px;
                   6934:   margin: 0;
1.933     droeschl 6935:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6936: }
                   6937: 
1.911     bisitz   6938: ol#LC_MenuBreadcrumbs li,
                   6939: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6940: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6941:   display: inline;
1.933     droeschl 6942:   white-space: normal;  
1.693     droeschl 6943: }
                   6944: 
1.823     bisitz   6945: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6946: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6947:   text-decoration: none;
                   6948:   font-size:90%;
1.693     droeschl 6949: }
1.795     www      6950: 
1.969     droeschl 6951: ol#LC_MenuBreadcrumbs h1 {
                   6952:   display: inline;
                   6953:   font-size: 90%;
                   6954:   line-height: 2.5em;
                   6955:   margin: 0;
                   6956:   padding: 0;
                   6957: }
                   6958: 
1.795     www      6959: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6960:   text-decoration:none;
                   6961:   font-size:100%;
                   6962:   font-weight:bold;
1.693     droeschl 6963: }
1.795     www      6964: 
1.840     bisitz   6965: .LC_Box {
1.911     bisitz   6966:   border: solid 1px $lg_border_color;
                   6967:   padding: 0 10px 10px 10px;
1.746     neumanie 6968: }
1.795     www      6969: 
1.1020    raeburn  6970: .LC_DocsBox {
                   6971:   border: solid 1px $lg_border_color;
                   6972:   padding: 0 0 10px 10px;
                   6973: }
                   6974: 
1.795     www      6975: .LC_AboutMe_Image {
1.911     bisitz   6976:   float:left;
                   6977:   margin-right:10px;
1.747     neumanie 6978: }
1.795     www      6979: 
                   6980: .LC_Clear_AboutMe_Image {
1.911     bisitz   6981:   clear:left;
1.747     neumanie 6982: }
1.795     www      6983: 
1.721     harmsja  6984: dl.LC_ListStyleClean dt {
1.911     bisitz   6985:   padding-right: 5px;
                   6986:   display: table-header-group;
1.693     droeschl 6987: }
                   6988: 
1.721     harmsja  6989: dl.LC_ListStyleClean dd {
1.911     bisitz   6990:   display: table-row;
1.693     droeschl 6991: }
                   6992: 
1.721     harmsja  6993: .LC_ListStyleClean,
                   6994: .LC_ListStyleSimple,
                   6995: .LC_ListStyleNormal,
1.795     www      6996: .LC_ListStyleSpecial {
1.911     bisitz   6997:   /* display:block; */
                   6998:   list-style-position: inside;
                   6999:   list-style-type: none;
                   7000:   overflow: hidden;
                   7001:   padding: 0;
1.693     droeschl 7002: }
                   7003: 
1.721     harmsja  7004: .LC_ListStyleSimple li,
                   7005: .LC_ListStyleSimple dd,
                   7006: .LC_ListStyleNormal li,
                   7007: .LC_ListStyleNormal dd,
                   7008: .LC_ListStyleSpecial li,
1.795     www      7009: .LC_ListStyleSpecial dd {
1.911     bisitz   7010:   margin: 0;
                   7011:   padding: 5px 5px 5px 10px;
                   7012:   clear: both;
1.693     droeschl 7013: }
                   7014: 
1.721     harmsja  7015: .LC_ListStyleClean li,
                   7016: .LC_ListStyleClean dd {
1.911     bisitz   7017:   padding-top: 0;
                   7018:   padding-bottom: 0;
1.693     droeschl 7019: }
                   7020: 
1.721     harmsja  7021: .LC_ListStyleSimple dd,
1.795     www      7022: .LC_ListStyleSimple li {
1.911     bisitz   7023:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7024: }
                   7025: 
1.721     harmsja  7026: .LC_ListStyleSpecial li,
                   7027: .LC_ListStyleSpecial dd {
1.911     bisitz   7028:   list-style-type: none;
                   7029:   background-color: RGB(220, 220, 220);
                   7030:   margin-bottom: 4px;
1.693     droeschl 7031: }
                   7032: 
1.721     harmsja  7033: table.LC_SimpleTable {
1.911     bisitz   7034:   margin:5px;
                   7035:   border:solid 1px $lg_border_color;
1.795     www      7036: }
1.693     droeschl 7037: 
1.721     harmsja  7038: table.LC_SimpleTable tr {
1.911     bisitz   7039:   padding: 0;
                   7040:   border:solid 1px $lg_border_color;
1.693     droeschl 7041: }
1.795     www      7042: 
                   7043: table.LC_SimpleTable thead {
1.911     bisitz   7044:   background:rgb(220,220,220);
1.693     droeschl 7045: }
                   7046: 
1.721     harmsja  7047: div.LC_columnSection {
1.911     bisitz   7048:   display: block;
                   7049:   clear: both;
                   7050:   overflow: hidden;
                   7051:   margin: 0;
1.693     droeschl 7052: }
                   7053: 
1.721     harmsja  7054: div.LC_columnSection>* {
1.911     bisitz   7055:   float: left;
                   7056:   margin: 10px 20px 10px 0;
                   7057:   overflow:hidden;
1.693     droeschl 7058: }
1.721     harmsja  7059: 
1.795     www      7060: table em {
1.911     bisitz   7061:   font-weight: bold;
                   7062:   font-style: normal;
1.748     schulted 7063: }
1.795     www      7064: 
1.779     bisitz   7065: table.LC_tableBrowseRes,
1.795     www      7066: table.LC_tableOfContent {
1.911     bisitz   7067:   border:none;
                   7068:   border-spacing: 1px;
                   7069:   padding: 3px;
                   7070:   background-color: #FFFFFF;
                   7071:   font-size: 90%;
1.753     droeschl 7072: }
1.789     droeschl 7073: 
1.911     bisitz   7074: table.LC_tableOfContent {
                   7075:   border-collapse: collapse;
1.789     droeschl 7076: }
                   7077: 
1.771     droeschl 7078: table.LC_tableBrowseRes a,
1.768     schulted 7079: table.LC_tableOfContent a {
1.911     bisitz   7080:   background-color: transparent;
                   7081:   text-decoration: none;
1.753     droeschl 7082: }
                   7083: 
1.795     www      7084: table.LC_tableOfContent img {
1.911     bisitz   7085:   border: none;
                   7086:   height: 1.3em;
                   7087:   vertical-align: text-bottom;
                   7088:   margin-right: 0.3em;
1.753     droeschl 7089: }
1.757     schulted 7090: 
1.795     www      7091: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7092:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7093: }
                   7094: 
1.795     www      7095: a#LC_content_toolbar_everything {
1.911     bisitz   7096:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7097: }
                   7098: 
1.795     www      7099: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7100:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7101: }
                   7102: 
1.795     www      7103: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7104:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7105: }
                   7106: 
1.795     www      7107: a#LC_content_toolbar_changefolder {
1.911     bisitz   7108:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7109: }
                   7110: 
1.795     www      7111: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7112:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7113: }
                   7114: 
1.1043    raeburn  7115: a#LC_content_toolbar_edittoplevel {
                   7116:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7117: }
                   7118: 
1.795     www      7119: ul#LC_toolbar li a:hover {
1.911     bisitz   7120:   background-position: bottom center;
1.757     schulted 7121: }
                   7122: 
1.795     www      7123: ul#LC_toolbar {
1.911     bisitz   7124:   padding: 0;
                   7125:   margin: 2px;
                   7126:   list-style:none;
                   7127:   position:relative;
                   7128:   background-color:white;
1.1075.2.9  raeburn  7129:   overflow: auto;
1.757     schulted 7130: }
                   7131: 
1.795     www      7132: ul#LC_toolbar li {
1.911     bisitz   7133:   border:1px solid white;
                   7134:   padding: 0;
                   7135:   margin: 0;
                   7136:   float: left;
                   7137:   display:inline;
                   7138:   vertical-align:middle;
1.1075.2.9  raeburn  7139:   white-space: nowrap;
1.911     bisitz   7140: }
1.757     schulted 7141: 
1.783     amueller 7142: 
1.795     www      7143: a.LC_toolbarItem {
1.911     bisitz   7144:   display:block;
                   7145:   padding: 0;
                   7146:   margin: 0;
                   7147:   height: 32px;
                   7148:   width: 32px;
                   7149:   color:white;
                   7150:   border: none;
                   7151:   background-repeat:no-repeat;
                   7152:   background-color:transparent;
1.757     schulted 7153: }
                   7154: 
1.915     droeschl 7155: ul.LC_funclist {
                   7156:     margin: 0;
                   7157:     padding: 0.5em 1em 0.5em 0;
                   7158: }
                   7159: 
1.933     droeschl 7160: ul.LC_funclist > li:first-child {
                   7161:     font-weight:bold; 
                   7162:     margin-left:0.8em;
                   7163: }
                   7164: 
1.915     droeschl 7165: ul.LC_funclist + ul.LC_funclist {
                   7166:     /* 
                   7167:        left border as a seperator if we have more than
                   7168:        one list 
                   7169:     */
                   7170:     border-left: 1px solid $sidebg;
                   7171:     /* 
                   7172:        this hides the left border behind the border of the 
                   7173:        outer box if element is wrapped to the next 'line' 
                   7174:     */
                   7175:     margin-left: -1px;
                   7176: }
                   7177: 
1.843     bisitz   7178: ul.LC_funclist li {
1.915     droeschl 7179:   display: inline;
1.782     bisitz   7180:   white-space: nowrap;
1.915     droeschl 7181:   margin: 0 0 0 25px;
                   7182:   line-height: 150%;
1.782     bisitz   7183: }
                   7184: 
1.974     wenzelju 7185: .LC_hidden {
                   7186:   display: none;
                   7187: }
                   7188: 
1.1030    www      7189: .LCmodal-overlay {
                   7190: 		position:fixed;
                   7191: 		top:0;
                   7192: 		right:0;
                   7193: 		bottom:0;
                   7194: 		left:0;
                   7195: 		height:100%;
                   7196: 		width:100%;
                   7197: 		margin:0;
                   7198: 		padding:0;
                   7199: 		background:#999;
                   7200: 		opacity:.75;
                   7201: 		filter: alpha(opacity=75);
                   7202: 		-moz-opacity: 0.75;
                   7203: 		z-index:101;
                   7204: }
                   7205: 
                   7206: * html .LCmodal-overlay {   
                   7207: 		position: absolute;
                   7208: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7209: }
                   7210: 
                   7211: .LCmodal-window {
                   7212: 		position:fixed;
                   7213: 		top:50%;
                   7214: 		left:50%;
                   7215: 		margin:0;
                   7216: 		padding:0;
                   7217: 		z-index:102;
                   7218: 	}
                   7219: 
                   7220: * html .LCmodal-window {
                   7221: 		position:absolute;
                   7222: }
                   7223: 
                   7224: .LCclose-window {
                   7225: 		position:absolute;
                   7226: 		width:32px;
                   7227: 		height:32px;
                   7228: 		right:8px;
                   7229: 		top:8px;
                   7230: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7231: 		text-indent:-99999px;
                   7232: 		overflow:hidden;
                   7233: 		cursor:pointer;
                   7234: }
                   7235: 
1.1075.2.17  raeburn  7236: /*
                   7237:   styles used by TTH when "Default set of options to pass to tth/m
                   7238:   when converting TeX" in course settings has been set
                   7239: 
                   7240:   option passed: -t
                   7241: 
                   7242: */
                   7243: 
                   7244: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7245: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7246: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7247: td div.norm {line-height:normal;}
                   7248: 
                   7249: /*
                   7250:   option passed -y3
                   7251: */
                   7252: 
                   7253: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7254: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7255: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7256: 
1.343     albertel 7257: END
                   7258: }
                   7259: 
1.306     albertel 7260: =pod
                   7261: 
                   7262: =item * &headtag()
                   7263: 
                   7264: Returns a uniform footer for LON-CAPA web pages.
                   7265: 
1.307     albertel 7266: Inputs: $title - optional title for the head
                   7267:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7268:         $args - optional arguments
1.319     albertel 7269:             force_register - if is true call registerurl so the remote is 
                   7270:                              informed
1.415     albertel 7271:             redirect       -> array ref of
                   7272:                                    1- seconds before redirect occurs
                   7273:                                    2- url to redirect to
                   7274:                                    3- whether the side effect should occur
1.315     albertel 7275:                            (side effect of setting 
                   7276:                                $env{'internal.head.redirect'} to the url 
                   7277:                                redirected too)
1.352     albertel 7278:             domain         -> force to color decorate a page for a specific
                   7279:                                domain
                   7280:             function       -> force usage of a specific rolish color scheme
                   7281:             bgcolor        -> override the default page bgcolor
1.460     albertel 7282:             no_auto_mt_title
                   7283:                            -> prevent &mt()ing the title arg
1.464     albertel 7284: 
1.306     albertel 7285: =cut
                   7286: 
                   7287: sub headtag {
1.313     albertel 7288:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7289:     
1.363     albertel 7290:     my $function = $args->{'function'} || &get_users_function();
                   7291:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7292:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1075.2.52  raeburn  7293:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7294:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7295: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7296: 		   #time(),
1.418     albertel 7297: 		   $env{'environment.color.timestamp'},
1.363     albertel 7298: 		   $function,$domain,$bgcolor);
                   7299: 
1.369     www      7300:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7301: 
1.308     albertel 7302:     my $result =
                   7303: 	'<head>'.
1.1075.2.56  raeburn  7304: 	&font_settings($args);
1.319     albertel 7305: 
1.1075.2.72  raeburn  7306:     my $inhibitprint;
                   7307:     if ($args->{'print_suppress'}) {
                   7308:         $inhibitprint = &print_suppression();
                   7309:     }
1.1064    raeburn  7310: 
1.461     albertel 7311:     if (!$args->{'frameset'}) {
                   7312: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7313:     }
1.1075.2.12  raeburn  7314:     if ($args->{'force_register'}) {
                   7315:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7316:     }
1.436     albertel 7317:     if (!$args->{'no_nav_bar'} 
                   7318: 	&& !$args->{'only_body'}
                   7319: 	&& !$args->{'frameset'}) {
1.1075.2.52  raeburn  7320: 	$result .= &help_menu_js($httphost);
1.1032    www      7321:         $result.=&modal_window();
1.1038    www      7322:         $result.=&togglebox_script();
1.1034    www      7323:         $result.=&wishlist_window();
1.1041    www      7324:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7325:     } else {
                   7326:         if ($args->{'add_modal'}) {
                   7327:            $result.=&modal_window();
                   7328:         }
                   7329:         if ($args->{'add_wishlist'}) {
                   7330:            $result.=&wishlist_window();
                   7331:         }
1.1038    www      7332:         if ($args->{'add_togglebox'}) {
                   7333:            $result.=&togglebox_script();
                   7334:         }
1.1041    www      7335:         if ($args->{'add_progressbar'}) {
                   7336:            $result.=&LCprogressbarUpdate_script();
                   7337:         }
1.436     albertel 7338:     }
1.314     albertel 7339:     if (ref($args->{'redirect'})) {
1.414     albertel 7340: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7341: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7342: 	if (!$inhibit_continue) {
                   7343: 	    $env{'internal.head.redirect'} = $url;
                   7344: 	}
1.313     albertel 7345: 	$result.=<<ADDMETA
                   7346: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7347: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7348: ADDMETA
                   7349:     }
1.306     albertel 7350:     if (!defined($title)) {
                   7351: 	$title = 'The LearningOnline Network with CAPA';
                   7352:     }
1.460     albertel 7353:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7354:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61  raeburn  7355: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7356:     if (!$args->{'frameset'}) {
                   7357:         $result .= ' /';
                   7358:     }
                   7359:     $result .= '>'
1.1064    raeburn  7360:         .$inhibitprint
1.414     albertel 7361: 	.$head_extra;
1.1075.2.42  raeburn  7362:     if ($env{'browser.mobile'}) {
                   7363:         $result .= '
                   7364: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7365: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7366:     }
1.962     droeschl 7367:     return $result.'</head>';
1.306     albertel 7368: }
                   7369: 
                   7370: =pod
                   7371: 
1.340     albertel 7372: =item * &font_settings()
                   7373: 
                   7374: Returns neccessary <meta> to set the proper encoding
                   7375: 
1.1075.2.56  raeburn  7376: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 7377: 
                   7378: =cut
                   7379: 
                   7380: sub font_settings {
1.1075.2.56  raeburn  7381:     my ($args) = @_;
1.340     albertel 7382:     my $headerstring='';
1.1075.2.56  raeburn  7383:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   7384:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340     albertel 7385: 	$headerstring.=
1.1075.2.61  raeburn  7386: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   7387:         if (!$args->{'frameset'}) {
                   7388:             $headerstring.= ' /';
                   7389:         }
                   7390:         $headerstring .= '>'."\n";
1.340     albertel 7391:     }
                   7392:     return $headerstring;
                   7393: }
                   7394: 
1.341     albertel 7395: =pod
                   7396: 
1.1064    raeburn  7397: =item * &print_suppression()
                   7398: 
                   7399: In course context returns css which causes the body to be blank when media="print",
                   7400: if printout generation is unavailable for the current resource.
                   7401: 
                   7402: This could be because:
                   7403: 
                   7404: (a) printstartdate is in the future
                   7405: 
                   7406: (b) printenddate is in the past
                   7407: 
                   7408: (c) there is an active exam block with "printout"
                   7409: functionality blocked
                   7410: 
                   7411: Users with pav, pfo or evb privileges are exempt.
                   7412: 
                   7413: Inputs: none
                   7414: 
                   7415: =cut
                   7416: 
                   7417: 
                   7418: sub print_suppression {
                   7419:     my $noprint;
                   7420:     if ($env{'request.course.id'}) {
                   7421:         my $scope = $env{'request.course.id'};
                   7422:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7423:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7424:             return;
                   7425:         }
                   7426:         if ($env{'request.course.sec'} ne '') {
                   7427:             $scope .= "/$env{'request.course.sec'}";
                   7428:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7429:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7430:                 return;
1.1064    raeburn  7431:             }
                   7432:         }
                   7433:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7434:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.73  raeburn  7435:         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064    raeburn  7436:         if ($blocked) {
                   7437:             my $checkrole = "cm./$cdom/$cnum";
                   7438:             if ($env{'request.course.sec'} ne '') {
                   7439:                 $checkrole .= "/$env{'request.course.sec'}";
                   7440:             }
                   7441:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7442:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7443:                 $noprint = 1;
                   7444:             }
                   7445:         }
                   7446:         unless ($noprint) {
                   7447:             my $symb = &Apache::lonnet::symbread();
                   7448:             if ($symb ne '') {
                   7449:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7450:                 if (ref($navmap)) {
                   7451:                     my $res = $navmap->getBySymb($symb);
                   7452:                     if (ref($res)) {
                   7453:                         if (!$res->resprintable()) {
                   7454:                             $noprint = 1;
                   7455:                         }
                   7456:                     }
                   7457:                 }
                   7458:             }
                   7459:         }
                   7460:         if ($noprint) {
                   7461:             return <<"ENDSTYLE";
                   7462: <style type="text/css" media="print">
                   7463:     body { display:none }
                   7464: </style>
                   7465: ENDSTYLE
                   7466:         }
                   7467:     }
                   7468:     return;
                   7469: }
                   7470: 
                   7471: =pod
                   7472: 
1.341     albertel 7473: =item * &xml_begin()
                   7474: 
                   7475: Returns the needed doctype and <html>
                   7476: 
                   7477: Inputs: none
                   7478: 
                   7479: =cut
                   7480: 
                   7481: sub xml_begin {
1.1075.2.61  raeburn  7482:     my ($is_frameset) = @_;
1.341     albertel 7483:     my $output='';
                   7484: 
                   7485:     if ($env{'browser.mathml'}) {
                   7486: 	$output='<?xml version="1.0"?>'
                   7487:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7488: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7489:             
                   7490: #	    .'<!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">] >'
                   7491: 	    .'<!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">'
                   7492:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7493: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61  raeburn  7494:     } elsif ($is_frameset) {
                   7495:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   7496:                 '<html>'."\n";
1.341     albertel 7497:     } else {
1.1075.2.61  raeburn  7498: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   7499:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 7500:     }
                   7501:     return $output;
                   7502: }
1.340     albertel 7503: 
                   7504: =pod
                   7505: 
1.306     albertel 7506: =item * &start_page()
                   7507: 
                   7508: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7509: 
1.648     raeburn  7510: Inputs:
                   7511: 
                   7512: =over 4
                   7513: 
                   7514: $title - optional title for the page
                   7515: 
                   7516: $head_extra - optional extra HTML to incude inside the <head>
                   7517: 
                   7518: $args - additional optional args supported are:
                   7519: 
                   7520: =over 8
                   7521: 
                   7522:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7523:                                     arg on
1.814     bisitz   7524:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7525:              add_entries    -> additional attributes to add to the  <body>
                   7526:              domain         -> force to color decorate a page for a 
1.317     albertel 7527:                                     specific domain
1.648     raeburn  7528:              function       -> force usage of a specific rolish color
1.317     albertel 7529:                                     scheme
1.648     raeburn  7530:              redirect       -> see &headtag()
                   7531:              bgcolor        -> override the default page bg color
                   7532:              js_ready       -> return a string ready for being used in 
1.317     albertel 7533:                                     a javascript writeln
1.648     raeburn  7534:              html_encode    -> return a string ready for being used in 
1.320     albertel 7535:                                     a html attribute
1.648     raeburn  7536:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7537:                                     $forcereg arg
1.648     raeburn  7538:              frameset       -> if true will start with a <frameset>
1.330     albertel 7539:                                     rather than <body>
1.648     raeburn  7540:              skip_phases    -> hash ref of 
1.338     albertel 7541:                                     head -> skip the <html><head> generation
                   7542:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  7543:              no_inline_link -> if true and in remote mode, don't show the
                   7544:                                     'Switch To Inline Menu' link
1.648     raeburn  7545:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7546:              inherit_jsmath -> when creating popup window in a page,
                   7547:                                     should it have jsmath forced on by the
                   7548:                                     current page
1.867     kalberla 7549:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7550:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.15  raeburn  7551:              group          -> includes the current group, if page is for a
                   7552:                                specific group
1.361     albertel 7553: 
1.648     raeburn  7554: =back
1.460     albertel 7555: 
1.648     raeburn  7556: =back
1.562     albertel 7557: 
1.306     albertel 7558: =cut
                   7559: 
                   7560: sub start_page {
1.309     albertel 7561:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7562:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7563: 
1.315     albertel 7564:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  7565:     my ($result,@advtools);
1.964     droeschl 7566: 
1.338     albertel 7567:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62  raeburn  7568:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 7569:     }
                   7570:     
                   7571:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7572: 	if ($args->{'frameset'}) {
                   7573: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7574: 						$args->{'add_entries'});
                   7575: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7576:         } else {
                   7577:             $result .=
                   7578:                 &bodytag($title, 
                   7579:                          $args->{'function'},       $args->{'add_entries'},
                   7580:                          $args->{'only_body'},      $args->{'domain'},
                   7581:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  7582:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  7583:                          $args,                     \@advtools);
1.831     bisitz   7584:         }
1.330     albertel 7585:     }
1.338     albertel 7586: 
1.315     albertel 7587:     if ($args->{'js_ready'}) {
1.713     kaisler  7588: 		$result = &js_ready($result);
1.315     albertel 7589:     }
1.320     albertel 7590:     if ($args->{'html_encode'}) {
1.713     kaisler  7591: 		$result = &html_encode($result);
                   7592:     }
                   7593: 
1.813     bisitz   7594:     # Preparation for new and consistent functionlist at top of screen
                   7595:     # if ($args->{'functionlist'}) {
                   7596:     #            $result .= &build_functionlist();
                   7597:     #}
                   7598: 
1.964     droeschl 7599:     # Don't add anything more if only_body wanted or in const space
                   7600:     return $result if    $args->{'only_body'} 
                   7601:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7602: 
                   7603:     #Breadcrumbs
1.758     kaisler  7604:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7605: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7606: 		#if any br links exists, add them to the breadcrumbs
                   7607: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7608: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7609: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7610: 			}
                   7611: 		}
1.1075.2.19  raeburn  7612:                 # if @advtools array contains items add then to the breadcrumbs
                   7613:                 if (@advtools > 0) {
                   7614:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7615:                 }
1.758     kaisler  7616: 
                   7617: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7618: 		if(exists($args->{'bread_crumbs_component'})){
                   7619: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7620: 		}else{
                   7621: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7622: 		}
1.1075.2.24  raeburn  7623:     } elsif (($env{'environment.remote'} eq 'on') &&
                   7624:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   7625:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   7626:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  7627:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 7628:     }
1.315     albertel 7629:     return $result;
1.306     albertel 7630: }
                   7631: 
                   7632: sub end_page {
1.315     albertel 7633:     my ($args) = @_;
                   7634:     $env{'internal.end_page'}++;
1.330     albertel 7635:     my $result;
1.335     albertel 7636:     if ($args->{'discussion'}) {
                   7637: 	my ($target,$parser);
                   7638: 	if (ref($args->{'discussion'})) {
                   7639: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7640: 				$args->{'discussion'}{'parser'});
                   7641: 	}
                   7642: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7643:     }
1.330     albertel 7644:     if ($args->{'frameset'}) {
                   7645: 	$result .= '</frameset>';
                   7646:     } else {
1.635     raeburn  7647: 	$result .= &endbodytag($args);
1.330     albertel 7648:     }
1.1075.2.6  raeburn  7649:     unless ($args->{'notbody'}) {
                   7650:         $result .= "\n</html>";
                   7651:     }
1.330     albertel 7652: 
1.315     albertel 7653:     if ($args->{'js_ready'}) {
1.317     albertel 7654: 	$result = &js_ready($result);
1.315     albertel 7655:     }
1.335     albertel 7656: 
1.320     albertel 7657:     if ($args->{'html_encode'}) {
                   7658: 	$result = &html_encode($result);
                   7659:     }
1.335     albertel 7660: 
1.315     albertel 7661:     return $result;
                   7662: }
                   7663: 
1.1034    www      7664: sub wishlist_window {
                   7665:     return(<<'ENDWISHLIST');
1.1046    raeburn  7666: <script type="text/javascript">
1.1034    www      7667: // <![CDATA[
                   7668: // <!-- BEGIN LON-CAPA Internal
                   7669: function set_wishlistlink(title, path) {
                   7670:     if (!title) {
                   7671:         title = document.title;
                   7672:         title = title.replace(/^LON-CAPA /,'');
                   7673:     }
1.1075.2.65  raeburn  7674:     title = encodeURIComponent(title);
1.1034    www      7675:     if (!path) {
                   7676:         path = location.pathname;
                   7677:     }
1.1075.2.65  raeburn  7678:     path = encodeURIComponent(path);
1.1034    www      7679:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7680:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7681: }
                   7682: // END LON-CAPA Internal -->
                   7683: // ]]>
                   7684: </script>
                   7685: ENDWISHLIST
                   7686: }
                   7687: 
1.1030    www      7688: sub modal_window {
                   7689:     return(<<'ENDMODAL');
1.1046    raeburn  7690: <script type="text/javascript">
1.1030    www      7691: // <![CDATA[
                   7692: // <!-- BEGIN LON-CAPA Internal
                   7693: var modalWindow = {
                   7694: 	parent:"body",
                   7695: 	windowId:null,
                   7696: 	content:null,
                   7697: 	width:null,
                   7698: 	height:null,
                   7699: 	close:function()
                   7700: 	{
                   7701: 	        $(".LCmodal-window").remove();
                   7702: 	        $(".LCmodal-overlay").remove();
                   7703: 	},
                   7704: 	open:function()
                   7705: 	{
                   7706: 		var modal = "";
                   7707: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7708: 		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;\">";
                   7709: 		modal += this.content;
                   7710: 		modal += "</div>";	
                   7711: 
                   7712: 		$(this.parent).append(modal);
                   7713: 
                   7714: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7715: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7716: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7717: 	}
                   7718: };
1.1075.2.42  raeburn  7719: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      7720: 	{
                   7721: 		modalWindow.windowId = "myModal";
                   7722: 		modalWindow.width = width;
                   7723: 		modalWindow.height = height;
1.1075.2.80! raeburn  7724: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      7725: 		modalWindow.open();
                   7726: 	};	
                   7727: // END LON-CAPA Internal -->
                   7728: // ]]>
                   7729: </script>
                   7730: ENDMODAL
                   7731: }
                   7732: 
                   7733: sub modal_link {
1.1075.2.42  raeburn  7734:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      7735:     unless ($width) { $width=480; }
                   7736:     unless ($height) { $height=400; }
1.1031    www      7737:     unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42  raeburn  7738:     unless ($transparency) { $transparency='true'; }
                   7739: 
1.1074    raeburn  7740:     my $target_attr;
                   7741:     if (defined($target)) {
                   7742:         $target_attr = 'target="'.$target.'"';
                   7743:     }
                   7744:     return <<"ENDLINK";
1.1075.2.42  raeburn  7745: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  7746:            $linktext</a>
                   7747: ENDLINK
1.1030    www      7748: }
                   7749: 
1.1032    www      7750: sub modal_adhoc_script {
                   7751:     my ($funcname,$width,$height,$content)=@_;
                   7752:     return (<<ENDADHOC);
1.1046    raeburn  7753: <script type="text/javascript">
1.1032    www      7754: // <![CDATA[
                   7755:         var $funcname = function()
                   7756:         {
                   7757:                 modalWindow.windowId = "myModal";
                   7758:                 modalWindow.width = $width;
                   7759:                 modalWindow.height = $height;
                   7760:                 modalWindow.content = '$content';
                   7761:                 modalWindow.open();
                   7762:         };  
                   7763: // ]]>
                   7764: </script>
                   7765: ENDADHOC
                   7766: }
                   7767: 
1.1041    www      7768: sub modal_adhoc_inner {
                   7769:     my ($funcname,$width,$height,$content)=@_;
                   7770:     my $innerwidth=$width-20;
                   7771:     $content=&js_ready(
1.1042    www      7772:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42  raeburn  7773:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   7774:                  $content.
1.1041    www      7775:                  &end_scrollbox().
1.1075.2.42  raeburn  7776:                  &end_page()
1.1041    www      7777:              );
                   7778:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7779: }
                   7780: 
                   7781: sub modal_adhoc_window {
                   7782:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7783:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7784:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7785: }
                   7786: 
                   7787: sub modal_adhoc_launch {
                   7788:     my ($funcname,$width,$height,$content)=@_;
                   7789:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7790: <script type="text/javascript">
                   7791: // <![CDATA[
                   7792: $funcname();
                   7793: // ]]>
                   7794: </script>
                   7795: ENDLAUNCH
                   7796: }
                   7797: 
                   7798: sub modal_adhoc_close {
                   7799:     return (<<ENDCLOSE);
                   7800: <script type="text/javascript">
                   7801: // <![CDATA[
                   7802: modalWindow.close();
                   7803: // ]]>
                   7804: </script>
                   7805: ENDCLOSE
                   7806: }
                   7807: 
1.1038    www      7808: sub togglebox_script {
                   7809:    return(<<ENDTOGGLE);
                   7810: <script type="text/javascript"> 
                   7811: // <![CDATA[
                   7812: function LCtoggleDisplay(id,hidetext,showtext) {
                   7813:    link = document.getElementById(id + "link").childNodes[0];
                   7814:    with (document.getElementById(id).style) {
                   7815:       if (display == "none" ) {
                   7816:           display = "inline";
                   7817:           link.nodeValue = hidetext;
                   7818:         } else {
                   7819:           display = "none";
                   7820:           link.nodeValue = showtext;
                   7821:        }
                   7822:    }
                   7823: }
                   7824: // ]]>
                   7825: </script>
                   7826: ENDTOGGLE
                   7827: }
                   7828: 
1.1039    www      7829: sub start_togglebox {
                   7830:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7831:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7832:     unless ($showtext) { $showtext=&mt('show'); }
                   7833:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7834:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7835:     return &start_data_table().
                   7836:            &start_data_table_header_row().
                   7837:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7838:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7839:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7840:            &end_data_table_header_row().
                   7841:            '<tr id="'.$id.'" style="display:none""><td>';
                   7842: }
                   7843: 
                   7844: sub end_togglebox {
                   7845:     return '</td></tr>'.&end_data_table();
                   7846: }
                   7847: 
1.1041    www      7848: sub LCprogressbar_script {
1.1045    www      7849:    my ($id)=@_;
1.1041    www      7850:    return(<<ENDPROGRESS);
                   7851: <script type="text/javascript">
                   7852: // <![CDATA[
1.1045    www      7853: \$('#progressbar$id').progressbar({
1.1041    www      7854:   value: 0,
                   7855:   change: function(event, ui) {
                   7856:     var newVal = \$(this).progressbar('option', 'value');
                   7857:     \$('.pblabel', this).text(LCprogressTxt);
                   7858:   }
                   7859: });
                   7860: // ]]>
                   7861: </script>
                   7862: ENDPROGRESS
                   7863: }
                   7864: 
                   7865: sub LCprogressbarUpdate_script {
                   7866:    return(<<ENDPROGRESSUPDATE);
                   7867: <style type="text/css">
                   7868: .ui-progressbar { position:relative; }
                   7869: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7870: </style>
                   7871: <script type="text/javascript">
                   7872: // <![CDATA[
1.1045    www      7873: var LCprogressTxt='---';
                   7874: 
                   7875: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7876:    LCprogressTxt=progresstext;
1.1045    www      7877:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7878: }
                   7879: // ]]>
                   7880: </script>
                   7881: ENDPROGRESSUPDATE
                   7882: }
                   7883: 
1.1042    www      7884: my $LClastpercent;
1.1045    www      7885: my $LCidcnt;
                   7886: my $LCcurrentid;
1.1042    www      7887: 
1.1041    www      7888: sub LCprogressbar {
1.1042    www      7889:     my ($r)=(@_);
                   7890:     $LClastpercent=0;
1.1045    www      7891:     $LCidcnt++;
                   7892:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7893:     my $starting=&mt('Starting');
                   7894:     my $content=(<<ENDPROGBAR);
1.1045    www      7895:   <div id="progressbar$LCcurrentid">
1.1041    www      7896:     <span class="pblabel">$starting</span>
                   7897:   </div>
                   7898: ENDPROGBAR
1.1045    www      7899:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7900: }
                   7901: 
                   7902: sub LCprogressbarUpdate {
1.1042    www      7903:     my ($r,$val,$text)=@_;
                   7904:     unless ($val) { 
                   7905:        if ($LClastpercent) {
                   7906:            $val=$LClastpercent;
                   7907:        } else {
                   7908:            $val=0;
                   7909:        }
                   7910:     }
1.1041    www      7911:     if ($val<0) { $val=0; }
                   7912:     if ($val>100) { $val=0; }
1.1042    www      7913:     $LClastpercent=$val;
1.1041    www      7914:     unless ($text) { $text=$val.'%'; }
                   7915:     $text=&js_ready($text);
1.1044    www      7916:     &r_print($r,<<ENDUPDATE);
1.1041    www      7917: <script type="text/javascript">
                   7918: // <![CDATA[
1.1045    www      7919: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7920: // ]]>
                   7921: </script>
                   7922: ENDUPDATE
1.1035    www      7923: }
                   7924: 
1.1042    www      7925: sub LCprogressbarClose {
                   7926:     my ($r)=@_;
                   7927:     $LClastpercent=0;
1.1044    www      7928:     &r_print($r,<<ENDCLOSE);
1.1042    www      7929: <script type="text/javascript">
                   7930: // <![CDATA[
1.1045    www      7931: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7932: // ]]>
                   7933: </script>
                   7934: ENDCLOSE
1.1044    www      7935: }
                   7936: 
                   7937: sub r_print {
                   7938:     my ($r,$to_print)=@_;
                   7939:     if ($r) {
                   7940:       $r->print($to_print);
                   7941:       $r->rflush();
                   7942:     } else {
                   7943:       print($to_print);
                   7944:     }
1.1042    www      7945: }
                   7946: 
1.320     albertel 7947: sub html_encode {
                   7948:     my ($result) = @_;
                   7949: 
1.322     albertel 7950:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7951:     
                   7952:     return $result;
                   7953: }
1.1044    www      7954: 
1.317     albertel 7955: sub js_ready {
                   7956:     my ($result) = @_;
                   7957: 
1.323     albertel 7958:     $result =~ s/[\n\r]/ /xmsg;
                   7959:     $result =~ s/\\/\\\\/xmsg;
                   7960:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7961:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7962:     
                   7963:     return $result;
                   7964: }
                   7965: 
1.315     albertel 7966: sub validate_page {
                   7967:     if (  exists($env{'internal.start_page'})
1.316     albertel 7968: 	  &&     $env{'internal.start_page'} > 1) {
                   7969: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7970: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7971: 				 $ENV{'request.filename'});
1.315     albertel 7972:     }
                   7973:     if (  exists($env{'internal.end_page'})
1.316     albertel 7974: 	  &&     $env{'internal.end_page'} > 1) {
                   7975: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7976: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7977: 				 $env{'request.filename'});
1.315     albertel 7978:     }
                   7979:     if (     exists($env{'internal.start_page'})
                   7980: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7981: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7982: 				 $env{'request.filename'});
1.315     albertel 7983:     }
                   7984:     if (   ! exists($env{'internal.start_page'})
                   7985: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7986: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7987: 				 $env{'request.filename'});
1.315     albertel 7988:     }
1.306     albertel 7989: }
1.315     albertel 7990: 
1.996     www      7991: 
                   7992: sub start_scrollbox {
1.1075.2.56  raeburn  7993:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  7994:     unless ($outerwidth) { $outerwidth='520px'; }
                   7995:     unless ($width) { $width='500px'; }
                   7996:     unless ($height) { $height='200px'; }
1.1075    raeburn  7997:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7998:     if ($id ne '') {
1.1075.2.42  raeburn  7999:         $table_id = ' id="table_'.$id.'"';
                   8000:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  8001:     }
1.1075    raeburn  8002:     if ($bgcolor ne '') {
                   8003:         $tdcol = "background-color: $bgcolor;";
                   8004:     }
1.1075.2.42  raeburn  8005:     my $nicescroll_js;
                   8006:     if ($env{'browser.mobile'}) {
                   8007:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   8008:     }
1.1075    raeburn  8009:     return <<"END";
1.1075.2.42  raeburn  8010: $nicescroll_js
                   8011: 
                   8012: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56  raeburn  8013: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075    raeburn  8014: END
1.996     www      8015: }
                   8016: 
                   8017: sub end_scrollbox {
1.1036    www      8018:     return '</div></td></tr></table>';
1.996     www      8019: }
                   8020: 
1.1075.2.42  raeburn  8021: sub nicescroll_javascript {
                   8022:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8023:     my %options;
                   8024:     if (ref($cursor) eq 'HASH') {
                   8025:         %options = %{$cursor};
                   8026:     }
                   8027:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8028:         $options{'railalign'} = 'left';
                   8029:     }
                   8030:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8031:         my $function  = &get_users_function();
                   8032:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
                   8033:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8034:             $options{'cursorcolor'} = '#00F';
                   8035:         }
                   8036:     }
                   8037:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8038:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
                   8039:             $options{'cursoropacity'}='1.0';
                   8040:         }
                   8041:     } else {
                   8042:         $options{'cursoropacity'}='1.0';
                   8043:     }
                   8044:     if ($options{'cursorfixedheight'} eq 'none') {
                   8045:         delete($options{'cursorfixedheight'});
                   8046:     } else {
                   8047:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8048:     }
                   8049:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8050:         delete($options{'railoffset'});
                   8051:     }
                   8052:     my @niceoptions;
                   8053:     while (my($key,$value) = each(%options)) {
                   8054:         if ($value =~ /^\{.+\}$/) {
                   8055:             push(@niceoptions,$key.':'.$value);
                   8056:         } else {
                   8057:             push(@niceoptions,$key.':"'.$value.'"');
                   8058:         }
                   8059:     }
                   8060:     my $nicescroll_js = '
                   8061: $(document).ready(
                   8062:       function() {
                   8063:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8064:       }
                   8065: );
                   8066: ';
                   8067:     if ($framecheck) {
                   8068:         $nicescroll_js .= '
                   8069: function expand_div(caller) {
                   8070:     if (top === self) {
                   8071:         document.getElementById("'.$id.'").style.width = "auto";
                   8072:         document.getElementById("'.$id.'").style.height = "auto";
                   8073:     } else {
                   8074:         try {
                   8075:             if (parent.frames) {
                   8076:                 if (parent.frames.length > 1) {
                   8077:                     var framesrc = parent.frames[1].location.href;
                   8078:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8079:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8080:                         document.getElementById("'.$id.'").style.width = "auto";
                   8081:                         document.getElementById("'.$id.'").style.height = "auto";
                   8082:                     }
                   8083:                 }
                   8084:             }
                   8085:         } catch (e) {
                   8086:             return;
                   8087:         }
                   8088:     }
                   8089:     return;
                   8090: }
                   8091: ';
                   8092:     }
                   8093:     if ($needjsready) {
                   8094:         $nicescroll_js = '
                   8095: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8096:     } else {
                   8097:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8098:     }
                   8099:     return $nicescroll_js;
                   8100: }
                   8101: 
1.318     albertel 8102: sub simple_error_page {
1.1075.2.49  raeburn  8103:     my ($r,$title,$msg,$args) = @_;
                   8104:     if (ref($args) eq 'HASH') {
                   8105:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8106:     } else {
                   8107:         $msg = &mt($msg);
                   8108:     }
                   8109: 
1.318     albertel 8110:     my $page =
                   8111: 	&Apache::loncommon::start_page($title).
1.1075.2.49  raeburn  8112: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8113: 	&Apache::loncommon::end_page();
                   8114:     if (ref($r)) {
                   8115: 	$r->print($page);
1.327     albertel 8116: 	return;
1.318     albertel 8117:     }
                   8118:     return $page;
                   8119: }
1.347     albertel 8120: 
                   8121: {
1.610     albertel 8122:     my @row_count;
1.961     onken    8123: 
                   8124:     sub start_data_table_count {
                   8125:         unshift(@row_count, 0);
                   8126:         return;
                   8127:     }
                   8128: 
                   8129:     sub end_data_table_count {
                   8130:         shift(@row_count);
                   8131:         return;
                   8132:     }
                   8133: 
1.347     albertel 8134:     sub start_data_table {
1.1018    raeburn  8135: 	my ($add_class,$id) = @_;
1.422     albertel 8136: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8137:         my $table_id;
                   8138:         if (defined($id)) {
                   8139:             $table_id = ' id="'.$id.'"';
                   8140:         }
1.961     onken    8141: 	&start_data_table_count();
1.1018    raeburn  8142: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8143:     }
                   8144: 
                   8145:     sub end_data_table {
1.961     onken    8146: 	&end_data_table_count();
1.389     albertel 8147: 	return '</table>'."\n";;
1.347     albertel 8148:     }
                   8149: 
                   8150:     sub start_data_table_row {
1.974     wenzelju 8151: 	my ($add_class, $id) = @_;
1.610     albertel 8152: 	$row_count[0]++;
                   8153: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8154: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8155:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8156:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8157:     }
1.471     banghart 8158:     
                   8159:     sub continue_data_table_row {
1.974     wenzelju 8160: 	my ($add_class, $id) = @_;
1.610     albertel 8161: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8162: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8163:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8164:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8165:     }
1.347     albertel 8166: 
                   8167:     sub end_data_table_row {
1.389     albertel 8168: 	return '</tr>'."\n";;
1.347     albertel 8169:     }
1.367     www      8170: 
1.421     albertel 8171:     sub start_data_table_empty_row {
1.707     bisitz   8172: #	$row_count[0]++;
1.421     albertel 8173: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8174:     }
                   8175: 
                   8176:     sub end_data_table_empty_row {
                   8177: 	return '</tr>'."\n";;
                   8178:     }
                   8179: 
1.367     www      8180:     sub start_data_table_header_row {
1.389     albertel 8181: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8182:     }
                   8183: 
                   8184:     sub end_data_table_header_row {
1.389     albertel 8185: 	return '</tr>'."\n";;
1.367     www      8186:     }
1.890     droeschl 8187: 
                   8188:     sub data_table_caption {
                   8189:         my $caption = shift;
                   8190:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8191:     }
1.347     albertel 8192: }
                   8193: 
1.548     albertel 8194: =pod
                   8195: 
                   8196: =item * &inhibit_menu_check($arg)
                   8197: 
                   8198: Checks for a inhibitmenu state and generates output to preserve it
                   8199: 
                   8200: Inputs:         $arg - can be any of
                   8201:                      - undef - in which case the return value is a string 
                   8202:                                to add  into arguments list of a uri
                   8203:                      - 'input' - in which case the return value is a HTML
                   8204:                                  <form> <input> field of type hidden to
                   8205:                                  preserve the value
                   8206:                      - a url - in which case the return value is the url with
                   8207:                                the neccesary cgi args added to preserve the
                   8208:                                inhibitmenu state
                   8209:                      - a ref to a url - no return value, but the string is
                   8210:                                         updated to include the neccessary cgi
                   8211:                                         args to preserve the inhibitmenu state
                   8212: 
                   8213: =cut
                   8214: 
                   8215: sub inhibit_menu_check {
                   8216:     my ($arg) = @_;
                   8217:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8218:     if ($arg eq 'input') {
                   8219: 	if ($env{'form.inhibitmenu'}) {
                   8220: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8221: 	} else {
                   8222: 	    return
                   8223: 	}
                   8224:     }
                   8225:     if ($env{'form.inhibitmenu'}) {
                   8226: 	if (ref($arg)) {
                   8227: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8228: 	} elsif ($arg eq '') {
                   8229: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8230: 	} else {
                   8231: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8232: 	}
                   8233:     }
                   8234:     if (!ref($arg)) {
                   8235: 	return $arg;
                   8236:     }
                   8237: }
                   8238: 
1.251     albertel 8239: ###############################################
1.182     matthew  8240: 
                   8241: =pod
                   8242: 
1.549     albertel 8243: =back
                   8244: 
                   8245: =head1 User Information Routines
                   8246: 
                   8247: =over 4
                   8248: 
1.405     albertel 8249: =item * &get_users_function()
1.182     matthew  8250: 
                   8251: Used by &bodytag to determine the current users primary role.
                   8252: Returns either 'student','coordinator','admin', or 'author'.
                   8253: 
                   8254: =cut
                   8255: 
                   8256: ###############################################
                   8257: sub get_users_function {
1.815     tempelho 8258:     my $function = 'norole';
1.818     tempelho 8259:     if ($env{'request.role'}=~/^(st)/) {
                   8260:         $function='student';
                   8261:     }
1.907     raeburn  8262:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8263:         $function='coordinator';
                   8264:     }
1.258     albertel 8265:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8266:         $function='admin';
                   8267:     }
1.826     bisitz   8268:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8269:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8270:         $function='author';
                   8271:     }
                   8272:     return $function;
1.54      www      8273: }
1.99      www      8274: 
                   8275: ###############################################
                   8276: 
1.233     raeburn  8277: =pod
                   8278: 
1.821     raeburn  8279: =item * &show_course()
                   8280: 
                   8281: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8282: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8283: 
                   8284: Inputs:
                   8285: None
                   8286: 
                   8287: Outputs:
                   8288: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8289: 
                   8290: =cut
                   8291: 
                   8292: ###############################################
                   8293: sub show_course {
                   8294:     my $course = !$env{'user.adv'};
                   8295:     if (!$env{'user.adv'}) {
                   8296:         foreach my $env (keys(%env)) {
                   8297:             next if ($env !~ m/^user\.priv\./);
                   8298:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8299:                 $course = 0;
                   8300:                 last;
                   8301:             }
                   8302:         }
                   8303:     }
                   8304:     return $course;
                   8305: }
                   8306: 
                   8307: ###############################################
                   8308: 
                   8309: =pod
                   8310: 
1.542     raeburn  8311: =item * &check_user_status()
1.274     raeburn  8312: 
                   8313: Determines current status of supplied role for a
                   8314: specific user. Roles can be active, previous or future.
                   8315: 
                   8316: Inputs: 
                   8317: user's domain, user's username, course's domain,
1.375     raeburn  8318: course's number, optional section ID.
1.274     raeburn  8319: 
                   8320: Outputs:
                   8321: role status: active, previous or future. 
                   8322: 
                   8323: =cut
                   8324: 
                   8325: sub check_user_status {
1.412     raeburn  8326:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8327:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8328:     my @uroles = keys %userinfo;
                   8329:     my $srchstr;
                   8330:     my $active_chk = 'none';
1.412     raeburn  8331:     my $now = time;
1.274     raeburn  8332:     if (@uroles > 0) {
1.908     raeburn  8333:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8334:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8335:         } else {
1.412     raeburn  8336:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8337:         }
                   8338:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8339:             my $role_end = 0;
                   8340:             my $role_start = 0;
                   8341:             $active_chk = 'active';
1.412     raeburn  8342:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8343:                 $role_end = $1;
                   8344:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8345:                     $role_start = $1;
1.274     raeburn  8346:                 }
                   8347:             }
                   8348:             if ($role_start > 0) {
1.412     raeburn  8349:                 if ($now < $role_start) {
1.274     raeburn  8350:                     $active_chk = 'future';
                   8351:                 }
                   8352:             }
                   8353:             if ($role_end > 0) {
1.412     raeburn  8354:                 if ($now > $role_end) {
1.274     raeburn  8355:                     $active_chk = 'previous';
                   8356:                 }
                   8357:             }
                   8358:         }
                   8359:     }
                   8360:     return $active_chk;
                   8361: }
                   8362: 
                   8363: ###############################################
                   8364: 
                   8365: =pod
                   8366: 
1.405     albertel 8367: =item * &get_sections()
1.233     raeburn  8368: 
                   8369: Determines all the sections for a course including
                   8370: sections with students and sections containing other roles.
1.419     raeburn  8371: Incoming parameters: 
                   8372: 
                   8373: 1. domain
                   8374: 2. course number 
                   8375: 3. reference to array containing roles for which sections should 
                   8376: be gathered (optional).
                   8377: 4. reference to array containing status types for which sections 
                   8378: should be gathered (optional).
                   8379: 
                   8380: If the third argument is undefined, sections are gathered for any role. 
                   8381: If the fourth argument is undefined, sections are gathered for any status.
                   8382: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8383:  
1.374     raeburn  8384: Returns section hash (keys are section IDs, values are
                   8385: number of users in each section), subject to the
1.419     raeburn  8386: optional roles filter, optional status filter 
1.233     raeburn  8387: 
                   8388: =cut
                   8389: 
                   8390: ###############################################
                   8391: sub get_sections {
1.419     raeburn  8392:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8393:     if (!defined($cdom) || !defined($cnum)) {
                   8394:         my $cid =  $env{'request.course.id'};
                   8395: 
                   8396: 	return if (!defined($cid));
                   8397: 
                   8398:         $cdom = $env{'course.'.$cid.'.domain'};
                   8399:         $cnum = $env{'course.'.$cid.'.num'};
                   8400:     }
                   8401: 
                   8402:     my %sectioncount;
1.419     raeburn  8403:     my $now = time;
1.240     albertel 8404: 
1.1075.2.33  raeburn  8405:     my $check_students = 1;
                   8406:     my $only_students = 0;
                   8407:     if (ref($possible_roles) eq 'ARRAY') {
                   8408:         if (grep(/^st$/,@{$possible_roles})) {
                   8409:             if (@{$possible_roles} == 1) {
                   8410:                 $only_students = 1;
                   8411:             }
                   8412:         } else {
                   8413:             $check_students = 0;
                   8414:         }
                   8415:     }
                   8416: 
                   8417:     if ($check_students) {
1.276     albertel 8418: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8419: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8420: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8421:         my $start_index = &Apache::loncoursedata::CL_START();
                   8422:         my $end_index = &Apache::loncoursedata::CL_END();
                   8423:         my $status;
1.366     albertel 8424: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8425: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8426: 				                     $data->[$status_index],
                   8427:                                                      $data->[$start_index],
                   8428:                                                      $data->[$end_index]);
                   8429:             if ($stu_status eq 'Active') {
                   8430:                 $status = 'active';
                   8431:             } elsif ($end < $now) {
                   8432:                 $status = 'previous';
                   8433:             } elsif ($start > $now) {
                   8434:                 $status = 'future';
                   8435:             } 
                   8436: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8437:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8438:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8439: 		    $sectioncount{$section}++;
                   8440:                 }
1.240     albertel 8441: 	    }
                   8442: 	}
                   8443:     }
1.1075.2.33  raeburn  8444:     if ($only_students) {
                   8445:         return %sectioncount;
                   8446:     }
1.240     albertel 8447:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8448:     foreach my $user (sort(keys(%courseroles))) {
                   8449: 	if ($user !~ /^(\w{2})/) { next; }
                   8450: 	my ($role) = ($user =~ /^(\w{2})/);
                   8451: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8452: 	my ($section,$status);
1.240     albertel 8453: 	if ($role eq 'cr' &&
                   8454: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8455: 	    $section=$1;
                   8456: 	}
                   8457: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8458: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8459:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8460:         if ($end == -1 && $start == -1) {
                   8461:             next; #deleted role
                   8462:         }
                   8463:         if (!defined($possible_status)) { 
                   8464:             $sectioncount{$section}++;
                   8465:         } else {
                   8466:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8467:                 $status = 'active';
                   8468:             } elsif ($end < $now) {
                   8469:                 $status = 'future';
                   8470:             } elsif ($start > $now) {
                   8471:                 $status = 'previous';
                   8472:             }
                   8473:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8474:                 $sectioncount{$section}++;
                   8475:             }
                   8476:         }
1.233     raeburn  8477:     }
1.366     albertel 8478:     return %sectioncount;
1.233     raeburn  8479: }
                   8480: 
1.274     raeburn  8481: ###############################################
1.294     raeburn  8482: 
                   8483: =pod
1.405     albertel 8484: 
                   8485: =item * &get_course_users()
                   8486: 
1.275     raeburn  8487: Retrieves usernames:domains for users in the specified course
                   8488: with specific role(s), and access status. 
                   8489: 
                   8490: Incoming parameters:
1.277     albertel 8491: 1. course domain
                   8492: 2. course number
                   8493: 3. access status: users must have - either active, 
1.275     raeburn  8494: previous, future, or all.
1.277     albertel 8495: 4. reference to array of permissible roles
1.288     raeburn  8496: 5. reference to array of section restrictions (optional)
                   8497: 6. reference to results object (hash of hashes).
                   8498: 7. reference to optional userdata hash
1.609     raeburn  8499: 8. reference to optional statushash
1.630     raeburn  8500: 9. flag if privileged users (except those set to unhide in
                   8501:    course settings) should be excluded    
1.609     raeburn  8502: Keys of top level results hash are roles.
1.275     raeburn  8503: Keys of inner hashes are username:domain, with 
                   8504: values set to access type.
1.288     raeburn  8505: Optional userdata hash returns an array with arguments in the 
                   8506: same order as loncoursedata::get_classlist() for student data.
                   8507: 
1.609     raeburn  8508: Optional statushash returns
                   8509: 
1.288     raeburn  8510: Entries for end, start, section and status are blank because
                   8511: of the possibility of multiple values for non-student roles.
                   8512: 
1.275     raeburn  8513: =cut
1.405     albertel 8514: 
1.275     raeburn  8515: ###############################################
1.405     albertel 8516: 
1.275     raeburn  8517: sub get_course_users {
1.630     raeburn  8518:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8519:     my %idx = ();
1.419     raeburn  8520:     my %seclists;
1.288     raeburn  8521: 
                   8522:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8523:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8524:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8525:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8526:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8527:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8528:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8529:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8530: 
1.290     albertel 8531:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8532:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8533:         my $now = time;
1.277     albertel 8534:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8535:             my $match = 0;
1.412     raeburn  8536:             my $secmatch = 0;
1.419     raeburn  8537:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8538:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8539:             if ($section eq '') {
                   8540:                 $section = 'none';
                   8541:             }
1.291     albertel 8542:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8543:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8544:                     $secmatch = 1;
                   8545:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8546:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8547:                         $secmatch = 1;
                   8548:                     }
                   8549:                 } else {  
1.419     raeburn  8550: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8551: 		        $secmatch = 1;
                   8552:                     }
1.290     albertel 8553: 		}
1.412     raeburn  8554:                 if (!$secmatch) {
                   8555:                     next;
                   8556:                 }
1.419     raeburn  8557:             }
1.275     raeburn  8558:             if (defined($$types{'active'})) {
1.288     raeburn  8559:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8560:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8561:                     $match = 1;
1.275     raeburn  8562:                 }
                   8563:             }
                   8564:             if (defined($$types{'previous'})) {
1.609     raeburn  8565:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8566:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8567:                     $match = 1;
1.275     raeburn  8568:                 }
                   8569:             }
                   8570:             if (defined($$types{'future'})) {
1.609     raeburn  8571:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8572:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8573:                     $match = 1;
1.275     raeburn  8574:                 }
                   8575:             }
1.609     raeburn  8576:             if ($match) {
                   8577:                 push(@{$seclists{$student}},$section);
                   8578:                 if (ref($userdata) eq 'HASH') {
                   8579:                     $$userdata{$student} = $$classlist{$student};
                   8580:                 }
                   8581:                 if (ref($statushash) eq 'HASH') {
                   8582:                     $statushash->{$student}{'st'}{$section} = $status;
                   8583:                 }
1.288     raeburn  8584:             }
1.275     raeburn  8585:         }
                   8586:     }
1.412     raeburn  8587:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8588:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8589:         my $now = time;
1.609     raeburn  8590:         my %displaystatus = ( previous => 'Expired',
                   8591:                               active   => 'Active',
                   8592:                               future   => 'Future',
                   8593:                             );
1.1075.2.36  raeburn  8594:         my (%nothide,@possdoms);
1.630     raeburn  8595:         if ($hidepriv) {
                   8596:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8597:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8598:                 if ($user !~ /:/) {
                   8599:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8600:                 } else {
                   8601:                     $nothide{$user} = 1;
                   8602:                 }
                   8603:             }
1.1075.2.36  raeburn  8604:             my @possdoms = ($cdom);
                   8605:             if ($coursehash{'checkforpriv'}) {
                   8606:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   8607:             }
1.630     raeburn  8608:         }
1.439     raeburn  8609:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8610:             my $match = 0;
1.412     raeburn  8611:             my $secmatch = 0;
1.439     raeburn  8612:             my $status;
1.412     raeburn  8613:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8614:             $user =~ s/:$//;
1.439     raeburn  8615:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8616:             if ($end == -1 || $start == -1) {
                   8617:                 next;
                   8618:             }
                   8619:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8620:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8621:                 my ($uname,$udom) = split(/:/,$user);
                   8622:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8623:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8624:                         $secmatch = 1;
                   8625:                     } elsif ($usec eq '') {
1.420     albertel 8626:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8627:                             $secmatch = 1;
                   8628:                         }
                   8629:                     } else {
                   8630:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8631:                             $secmatch = 1;
                   8632:                         }
                   8633:                     }
                   8634:                     if (!$secmatch) {
                   8635:                         next;
                   8636:                     }
1.288     raeburn  8637:                 }
1.419     raeburn  8638:                 if ($usec eq '') {
                   8639:                     $usec = 'none';
                   8640:                 }
1.275     raeburn  8641:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8642:                     if ($hidepriv) {
1.1075.2.36  raeburn  8643:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  8644:                             (!$nothide{$uname.':'.$udom})) {
                   8645:                             next;
                   8646:                         }
                   8647:                     }
1.503     raeburn  8648:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8649:                         $status = 'previous';
                   8650:                     } elsif ($start > $now) {
                   8651:                         $status = 'future';
                   8652:                     } else {
                   8653:                         $status = 'active';
                   8654:                     }
1.277     albertel 8655:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8656:                         if ($status eq $type) {
1.420     albertel 8657:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8658:                                 push(@{$$users{$role}{$user}},$type);
                   8659:                             }
1.288     raeburn  8660:                             $match = 1;
                   8661:                         }
                   8662:                     }
1.419     raeburn  8663:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8664:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8665: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8666:                         }
1.420     albertel 8667:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8668:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8669:                         }
1.609     raeburn  8670:                         if (ref($statushash) eq 'HASH') {
                   8671:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8672:                         }
1.275     raeburn  8673:                     }
                   8674:                 }
                   8675:             }
                   8676:         }
1.290     albertel 8677:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8678:             if ((defined($cdom)) && (defined($cnum))) {
                   8679:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8680:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8681:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8682:                     next if ($owner eq '');
                   8683:                     my ($ownername,$ownerdom);
                   8684:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8685:                         $ownername = $1;
                   8686:                         $ownerdom = $2;
                   8687:                     } else {
                   8688:                         $ownername = $owner;
                   8689:                         $ownerdom = $cdom;
                   8690:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8691:                     }
                   8692:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8693:                     if (defined($userdata) && 
1.609     raeburn  8694: 			!exists($$userdata{$owner})) {
                   8695: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8696:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8697:                             push(@{$seclists{$owner}},'none');
                   8698:                         }
                   8699:                         if (ref($statushash) eq 'HASH') {
                   8700:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8701:                         }
1.290     albertel 8702: 		    }
1.279     raeburn  8703:                 }
                   8704:             }
                   8705:         }
1.419     raeburn  8706:         foreach my $user (keys(%seclists)) {
                   8707:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8708:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8709:         }
1.275     raeburn  8710:     }
                   8711:     return;
                   8712: }
                   8713: 
1.288     raeburn  8714: sub get_user_info {
                   8715:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8716:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8717: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8718:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8719:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8720:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8721:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8722:     return;
                   8723: }
1.275     raeburn  8724: 
1.472     raeburn  8725: ###############################################
                   8726: 
                   8727: =pod
                   8728: 
                   8729: =item * &get_user_quota()
                   8730: 
1.1075.2.41  raeburn  8731: Retrieves quota assigned for storage of user files.
                   8732: Default is to report quota for portfolio files.
1.472     raeburn  8733: 
                   8734: Incoming parameters:
                   8735: 1. user's username
                   8736: 2. user's domain
1.1075.2.41  raeburn  8737: 3. quota name - portfolio, author, or course
                   8738:    (if no quota name provided, defaults to portfolio).
1.1075.2.59  raeburn  8739: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42  raeburn  8740:    course
1.472     raeburn  8741: 
                   8742: Returns:
1.1075.2.58  raeburn  8743: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  8744: 2. (Optional) Type of setting: custom or default
                   8745:    (individually assigned or default for user's 
                   8746:    institutional status).
                   8747: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8748:    or student - types as defined in localenroll::inst_usertypes 
                   8749:    for user's domain, which determines default quota for user.
                   8750: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8751: 
                   8752: If a value has been stored in the user's environment, 
1.536     raeburn  8753: it will return that, otherwise it returns the maximal default
1.1075.2.41  raeburn  8754: defined for the user's institutional status(es) in the domain.
1.472     raeburn  8755: 
                   8756: =cut
                   8757: 
                   8758: ###############################################
                   8759: 
                   8760: 
                   8761: sub get_user_quota {
1.1075.2.42  raeburn  8762:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  8763:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8764:     if (!defined($udom)) {
                   8765:         $udom = $env{'user.domain'};
                   8766:     }
                   8767:     if (!defined($uname)) {
                   8768:         $uname = $env{'user.name'};
                   8769:     }
                   8770:     if (($udom eq '' || $uname eq '') ||
                   8771:         ($udom eq 'public') && ($uname eq 'public')) {
                   8772:         $quota = 0;
1.536     raeburn  8773:         $quotatype = 'default';
                   8774:         $defquota = 0; 
1.472     raeburn  8775:     } else {
1.536     raeburn  8776:         my $inststatus;
1.1075.2.41  raeburn  8777:         if ($quotaname eq 'course') {
                   8778:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   8779:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   8780:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   8781:             } else {
                   8782:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   8783:                 $quota = $cenv{'internal.uploadquota'};
                   8784:             }
1.536     raeburn  8785:         } else {
1.1075.2.41  raeburn  8786:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8787:                 if ($quotaname eq 'author') {
                   8788:                     $quota = $env{'environment.authorquota'};
                   8789:                 } else {
                   8790:                     $quota = $env{'environment.portfolioquota'};
                   8791:                 }
                   8792:                 $inststatus = $env{'environment.inststatus'};
                   8793:             } else {
                   8794:                 my %userenv = 
                   8795:                     &Apache::lonnet::get('environment',['portfolioquota',
                   8796:                                          'authorquota','inststatus'],$udom,$uname);
                   8797:                 my ($tmp) = keys(%userenv);
                   8798:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8799:                     if ($quotaname eq 'author') {
                   8800:                         $quota = $userenv{'authorquota'};
                   8801:                     } else {
                   8802:                         $quota = $userenv{'portfolioquota'};
                   8803:                     }
                   8804:                     $inststatus = $userenv{'inststatus'};
                   8805:                 } else {
                   8806:                     undef(%userenv);
                   8807:                 }
                   8808:             }
                   8809:         }
                   8810:         if ($quota eq '' || wantarray) {
                   8811:             if ($quotaname eq 'course') {
                   8812:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59  raeburn  8813:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
                   8814:                     ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42  raeburn  8815:                     $defquota = $domdefs{$crstype.'quota'};
                   8816:                 }
                   8817:                 if ($defquota eq '') {
                   8818:                     $defquota = 500;
                   8819:                 }
1.1075.2.41  raeburn  8820:             } else {
                   8821:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   8822:             }
                   8823:             if ($quota eq '') {
                   8824:                 $quota = $defquota;
                   8825:                 $quotatype = 'default';
                   8826:             } else {
                   8827:                 $quotatype = 'custom';
                   8828:             }
1.472     raeburn  8829:         }
                   8830:     }
1.536     raeburn  8831:     if (wantarray) {
                   8832:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8833:     } else {
                   8834:         return $quota;
                   8835:     }
1.472     raeburn  8836: }
                   8837: 
                   8838: ###############################################
                   8839: 
                   8840: =pod
                   8841: 
                   8842: =item * &default_quota()
                   8843: 
1.536     raeburn  8844: Retrieves default quota assigned for storage of user portfolio files,
                   8845: given an (optional) user's institutional status.
1.472     raeburn  8846: 
                   8847: Incoming parameters:
1.1075.2.42  raeburn  8848: 
1.472     raeburn  8849: 1. domain
1.536     raeburn  8850: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8851:    status types (e.g., faculty, staff, student etc.)
                   8852:    which apply to the user for whom the default is being retrieved.
                   8853:    If the institutional status string in undefined, the domain
1.1075.2.41  raeburn  8854:    default quota will be returned.
                   8855: 3.  quota name - portfolio, author, or course
                   8856:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  8857: 
                   8858: Returns:
1.1075.2.42  raeburn  8859: 
1.1075.2.58  raeburn  8860: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  8861: 2. (Optional) institutional type which determined the value of the
                   8862:    default quota.
1.472     raeburn  8863: 
                   8864: If a value has been stored in the domain's configuration db,
                   8865: it will return that, otherwise it returns 20 (for backwards 
                   8866: compatibility with domains which have not set up a configuration
1.1075.2.58  raeburn  8867: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  8868: 
1.536     raeburn  8869: If the user's status includes multiple types (e.g., staff and student),
                   8870: the largest default quota which applies to the user determines the
                   8871: default quota returned.
                   8872: 
1.472     raeburn  8873: =cut
                   8874: 
                   8875: ###############################################
                   8876: 
                   8877: 
                   8878: sub default_quota {
1.1075.2.41  raeburn  8879:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  8880:     my ($defquota,$settingstatus);
                   8881:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8882:                                             ['quotas'],$udom);
1.1075.2.41  raeburn  8883:     my $key = 'defaultquota';
                   8884:     if ($quotaname eq 'author') {
                   8885:         $key = 'authorquota';
                   8886:     }
1.622     raeburn  8887:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8888:         if ($inststatus ne '') {
1.765     raeburn  8889:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8890:             foreach my $item (@statuses) {
1.1075.2.41  raeburn  8891:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8892:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  8893:                         if ($defquota eq '') {
1.1075.2.41  raeburn  8894:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8895:                             $settingstatus = $item;
1.1075.2.41  raeburn  8896:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   8897:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8898:                             $settingstatus = $item;
                   8899:                         }
                   8900:                     }
1.1075.2.41  raeburn  8901:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  8902:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8903:                         if ($defquota eq '') {
                   8904:                             $defquota = $quotahash{'quotas'}{$item};
                   8905:                             $settingstatus = $item;
                   8906:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8907:                             $defquota = $quotahash{'quotas'}{$item};
                   8908:                             $settingstatus = $item;
                   8909:                         }
1.536     raeburn  8910:                     }
                   8911:                 }
                   8912:             }
                   8913:         }
                   8914:         if ($defquota eq '') {
1.1075.2.41  raeburn  8915:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8916:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   8917:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  8918:                 $defquota = $quotahash{'quotas'}{'default'};
                   8919:             }
1.536     raeburn  8920:             $settingstatus = 'default';
1.1075.2.42  raeburn  8921:             if ($defquota eq '') {
                   8922:                 if ($quotaname eq 'author') {
                   8923:                     $defquota = 500;
                   8924:                 }
                   8925:             }
1.536     raeburn  8926:         }
                   8927:     } else {
                   8928:         $settingstatus = 'default';
1.1075.2.41  raeburn  8929:         if ($quotaname eq 'author') {
                   8930:             $defquota = 500;
                   8931:         } else {
                   8932:             $defquota = 20;
                   8933:         }
1.536     raeburn  8934:     }
                   8935:     if (wantarray) {
                   8936:         return ($defquota,$settingstatus);
1.472     raeburn  8937:     } else {
1.536     raeburn  8938:         return $defquota;
1.472     raeburn  8939:     }
                   8940: }
                   8941: 
1.1075.2.41  raeburn  8942: ###############################################
                   8943: 
                   8944: =pod
                   8945: 
1.1075.2.42  raeburn  8946: =item * &excess_filesize_warning()
1.1075.2.41  raeburn  8947: 
                   8948: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42  raeburn  8949: of existing file within authoring space will cause quota for the authoring
                   8950: space to be exceeded.
                   8951: 
                   8952: Same, if upload of a file directly to a course/community via Course Editor
                   8953: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41  raeburn  8954: 
1.1075.2.61  raeburn  8955: Inputs: 7 
1.1075.2.42  raeburn  8956: 1. username or coursenum
1.1075.2.41  raeburn  8957: 2. domain
1.1075.2.42  raeburn  8958: 3. context ('author' or 'course')
1.1075.2.41  raeburn  8959: 4. filename of file for which action is being requested
                   8960: 5. filesize (kB) of file
                   8961: 6. action being taken: copy or upload.
1.1075.2.59  raeburn  8962: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41  raeburn  8963: 
                   8964: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
                   8965:          otherwise return null.
                   8966: 
1.1075.2.42  raeburn  8967: =back
                   8968: 
1.1075.2.41  raeburn  8969: =cut
                   8970: 
1.1075.2.42  raeburn  8971: sub excess_filesize_warning {
1.1075.2.59  raeburn  8972:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42  raeburn  8973:     my $current_disk_usage = 0;
1.1075.2.59  raeburn  8974:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42  raeburn  8975:     if ($context eq 'author') {
                   8976:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   8977:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   8978:     } else {
                   8979:         foreach my $subdir ('docs','supplemental') {
                   8980:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   8981:         }
                   8982:     }
1.1075.2.41  raeburn  8983:     $disk_quota = int($disk_quota * 1000);
                   8984:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69  raeburn  8985:         return '<p class="LC_warning">'.
1.1075.2.41  raeburn  8986:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69  raeburn  8987:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   8988:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41  raeburn  8989:                             $disk_quota,$current_disk_usage).
                   8990:                '</p>';
                   8991:     }
                   8992:     return;
                   8993: }
                   8994: 
                   8995: ###############################################
                   8996: 
                   8997: 
1.384     raeburn  8998: sub get_secgrprole_info {
                   8999:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   9000:     my %sections_count = &get_sections($cdom,$cnum);
                   9001:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   9002:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   9003:     my @groups = sort(keys(%curr_groups));
                   9004:     my $allroles = [];
                   9005:     my $rolehash;
                   9006:     my $accesshash = {
                   9007:                      active => 'Currently has access',
                   9008:                      future => 'Will have future access',
                   9009:                      previous => 'Previously had access',
                   9010:                   };
                   9011:     if ($needroles) {
                   9012:         $rolehash = {'all' => 'all'};
1.385     albertel 9013:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9014: 	if (&Apache::lonnet::error(%user_roles)) {
                   9015: 	    undef(%user_roles);
                   9016: 	}
                   9017:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9018:             my ($role)=split(/\:/,$item,2);
                   9019:             if ($role eq 'cr') { next; }
                   9020:             if ($role =~ /^cr/) {
                   9021:                 $$rolehash{$role} = (split('/',$role))[3];
                   9022:             } else {
                   9023:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9024:             }
                   9025:         }
                   9026:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9027:             push(@{$allroles},$key);
                   9028:         }
                   9029:         push (@{$allroles},'st');
                   9030:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9031:     }
                   9032:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9033: }
                   9034: 
1.555     raeburn  9035: sub user_picker {
1.994     raeburn  9036:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  9037:     my $currdom = $dom;
                   9038:     my %curr_selected = (
                   9039:                         srchin => 'dom',
1.580     raeburn  9040:                         srchby => 'lastname',
1.555     raeburn  9041:                       );
                   9042:     my $srchterm;
1.625     raeburn  9043:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9044:         if ($srch->{'srchby'} ne '') {
                   9045:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9046:         }
                   9047:         if ($srch->{'srchin'} ne '') {
                   9048:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9049:         }
                   9050:         if ($srch->{'srchtype'} ne '') {
                   9051:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9052:         }
                   9053:         if ($srch->{'srchdomain'} ne '') {
                   9054:             $currdom = $srch->{'srchdomain'};
                   9055:         }
                   9056:         $srchterm = $srch->{'srchterm'};
                   9057:     }
                   9058:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  9059:                     'usr'       => 'Search criteria',
1.563     raeburn  9060:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9061:                     'uname'     => 'username',
                   9062:                     'lastname'  => 'last name',
1.555     raeburn  9063:                     'lastfirst' => 'last name, first name',
1.558     albertel 9064:                     'crs'       => 'in this course',
1.576     raeburn  9065:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9066:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9067:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9068:                     'exact'     => 'is',
                   9069:                     'contains'  => 'contains',
1.569     raeburn  9070:                     'begins'    => 'begins with',
1.571     raeburn  9071:                     'youm'      => "You must include some text to search for.",
                   9072:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9073:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9074:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9075:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9076:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9077:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9078:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9079:                                        );
1.563     raeburn  9080:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9081:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9082: 
                   9083:     my @srchins = ('crs','dom','alc','instd');
                   9084: 
                   9085:     foreach my $option (@srchins) {
                   9086:         # FIXME 'alc' option unavailable until 
                   9087:         #       loncreateuser::print_user_query_page()
                   9088:         #       has been completed.
                   9089:         next if ($option eq 'alc');
1.880     raeburn  9090:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9091:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9092:         if ($curr_selected{'srchin'} eq $option) {
                   9093:             $srchinsel .= ' 
                   9094:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9095:         } else {
                   9096:             $srchinsel .= '
                   9097:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9098:         }
1.555     raeburn  9099:     }
1.563     raeburn  9100:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9101: 
                   9102:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9103:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9104:         if ($curr_selected{'srchby'} eq $option) {
                   9105:             $srchbysel .= '
                   9106:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9107:         } else {
                   9108:             $srchbysel .= '
                   9109:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9110:          }
                   9111:     }
                   9112:     $srchbysel .= "\n  </select>\n";
                   9113: 
                   9114:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9115:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9116:         if ($curr_selected{'srchtype'} eq $option) {
                   9117:             $srchtypesel .= '
                   9118:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9119:         } else {
                   9120:             $srchtypesel .= '
                   9121:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9122:         }
                   9123:     }
                   9124:     $srchtypesel .= "\n  </select>\n";
                   9125: 
1.558     albertel 9126:     my ($newuserscript,$new_user_create);
1.994     raeburn  9127:     my $context_dom = $env{'request.role.domain'};
                   9128:     if ($context eq 'requestcrs') {
                   9129:         if ($env{'form.coursedom'} ne '') { 
                   9130:             $context_dom = $env{'form.coursedom'};
                   9131:         }
                   9132:     }
1.556     raeburn  9133:     if ($forcenewuser) {
1.576     raeburn  9134:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9135:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9136:                 if ($cancreate) {
                   9137:                     $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>';
                   9138:                 } else {
1.799     bisitz   9139:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9140:                     my %usertypetext = (
                   9141:                         official   => 'institutional',
                   9142:                         unofficial => 'non-institutional',
                   9143:                     );
1.799     bisitz   9144:                     $new_user_create = '<p class="LC_warning">'
                   9145:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9146:                                       .' '
                   9147:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9148:                                           ,'<a href="'.$helplink.'">','</a>')
                   9149:                                       .'</p><br />';
1.627     raeburn  9150:                 }
1.576     raeburn  9151:             }
                   9152:         }
                   9153: 
1.556     raeburn  9154:         $newuserscript = <<"ENDSCRIPT";
                   9155: 
1.570     raeburn  9156: function setSearch(createnew,callingForm) {
1.556     raeburn  9157:     if (createnew == 1) {
1.570     raeburn  9158:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9159:             if (callingForm.srchby.options[i].value == 'uname') {
                   9160:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9161:             }
                   9162:         }
1.570     raeburn  9163:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9164:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9165: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9166:             }
                   9167:         }
1.570     raeburn  9168:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9169:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9170:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9171:             }
                   9172:         }
1.570     raeburn  9173:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9174:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9175:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9176:             }
                   9177:         }
                   9178:     }
                   9179: }
                   9180: ENDSCRIPT
1.558     albertel 9181: 
1.556     raeburn  9182:     }
                   9183: 
1.555     raeburn  9184:     my $output = <<"END_BLOCK";
1.556     raeburn  9185: <script type="text/javascript">
1.824     bisitz   9186: // <![CDATA[
1.570     raeburn  9187: function validateEntry(callingForm) {
1.558     albertel 9188: 
1.556     raeburn  9189:     var checkok = 1;
1.558     albertel 9190:     var srchin;
1.570     raeburn  9191:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9192: 	if ( callingForm.srchin[i].checked ) {
                   9193: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9194: 	}
                   9195:     }
                   9196: 
1.570     raeburn  9197:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9198:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9199:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9200:     var srchterm =  callingForm.srchterm.value;
                   9201:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9202:     var msg = "";
                   9203: 
                   9204:     if (srchterm == "") {
                   9205:         checkok = 0;
1.571     raeburn  9206:         msg += "$lt{'youm'}\\n";
1.556     raeburn  9207:     }
                   9208: 
1.569     raeburn  9209:     if (srchtype== 'begins') {
                   9210:         if (srchterm.length < 2) {
                   9211:             checkok = 0;
1.571     raeburn  9212:             msg += "$lt{'thte'}\\n";
1.569     raeburn  9213:         }
                   9214:     }
                   9215: 
1.556     raeburn  9216:     if (srchtype== 'contains') {
                   9217:         if (srchterm.length < 3) {
                   9218:             checkok = 0;
1.571     raeburn  9219:             msg += "$lt{'thet'}\\n";
1.556     raeburn  9220:         }
                   9221:     }
                   9222:     if (srchin == 'instd') {
                   9223:         if (srchdomain == '') {
                   9224:             checkok = 0;
1.571     raeburn  9225:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  9226:         }
                   9227:     }
                   9228:     if (srchin == 'dom') {
                   9229:         if (srchdomain == '') {
                   9230:             checkok = 0;
1.571     raeburn  9231:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  9232:         }
                   9233:     }
                   9234:     if (srchby == 'lastfirst') {
                   9235:         if (srchterm.indexOf(",") == -1) {
                   9236:             checkok = 0;
1.571     raeburn  9237:             msg += "$lt{'whus'}\\n";
1.556     raeburn  9238:         }
                   9239:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9240:             checkok = 0;
1.571     raeburn  9241:             msg += "$lt{'whse'}\\n";
1.556     raeburn  9242:         }
                   9243:     }
                   9244:     if (checkok == 0) {
1.571     raeburn  9245:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  9246:         return;
                   9247:     }
                   9248:     if (checkok == 1) {
1.570     raeburn  9249:         callingForm.submit();
1.556     raeburn  9250:     }
                   9251: }
                   9252: 
                   9253: $newuserscript
                   9254: 
1.824     bisitz   9255: // ]]>
1.556     raeburn  9256: </script>
1.558     albertel 9257: 
                   9258: $new_user_create
                   9259: 
1.555     raeburn  9260: END_BLOCK
1.558     albertel 9261: 
1.876     raeburn  9262:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   9263:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   9264:                $domform.
                   9265:                &Apache::lonhtmlcommon::row_closure().
                   9266:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   9267:                $srchbysel.
                   9268:                $srchtypesel. 
                   9269:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9270:                $srchinsel.
                   9271:                &Apache::lonhtmlcommon::row_closure(1). 
                   9272:                &Apache::lonhtmlcommon::end_pick_box().
                   9273:                '<br />';
1.555     raeburn  9274:     return $output;
                   9275: }
                   9276: 
1.612     raeburn  9277: sub user_rule_check {
1.615     raeburn  9278:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  9279:     my $response;
                   9280:     if (ref($usershash) eq 'HASH') {
                   9281:         foreach my $user (keys(%{$usershash})) {
                   9282:             my ($uname,$udom) = split(/:/,$user);
                   9283:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  9284:             my ($id,$newuser);
1.612     raeburn  9285:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  9286:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  9287:                 $id = $usershash->{$user}->{'id'};
                   9288:             }
                   9289:             my $inst_response;
                   9290:             if (ref($checks) eq 'HASH') {
                   9291:                 if (defined($checks->{'username'})) {
1.615     raeburn  9292:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  9293:                         &Apache::lonnet::get_instuser($udom,$uname);
                   9294:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  9295:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  9296:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   9297:                 }
1.615     raeburn  9298:             } else {
                   9299:                 ($inst_response,%{$inst_results->{$user}}) =
                   9300:                     &Apache::lonnet::get_instuser($udom,$uname);
                   9301:                 return;
1.612     raeburn  9302:             }
1.615     raeburn  9303:             if (!$got_rules->{$udom}) {
1.612     raeburn  9304:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9305:                                                   ['usercreation'],$udom);
                   9306:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  9307:                     foreach my $item ('username','id') {
1.612     raeburn  9308:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9309:                             $$curr_rules{$udom}{$item} = 
                   9310:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  9311:                         }
                   9312:                     }
                   9313:                 }
1.615     raeburn  9314:                 $got_rules->{$udom} = 1;  
1.585     raeburn  9315:             }
1.612     raeburn  9316:             foreach my $item (keys(%{$checks})) {
                   9317:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9318:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9319:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   9320:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   9321:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9322:                                 if ($rule_check{$rule}) {
                   9323:                                     $$rulematch{$user}{$item} = $rule;
                   9324:                                     if ($inst_response eq 'ok') {
1.615     raeburn  9325:                                         if (ref($inst_results) eq 'HASH') {
                   9326:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9327:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9328:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   9329:                                                 }
1.612     raeburn  9330:                                             }
                   9331:                                         }
1.615     raeburn  9332:                                     }
                   9333:                                     last;
1.585     raeburn  9334:                                 }
                   9335:                             }
                   9336:                         }
                   9337:                     }
                   9338:                 }
                   9339:             }
                   9340:         }
                   9341:     }
1.612     raeburn  9342:     return;
                   9343: }
                   9344: 
                   9345: sub user_rule_formats {
                   9346:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9347:     my %text = ( 
                   9348:                  'username' => 'Usernames',
                   9349:                  'id'       => 'IDs',
                   9350:                );
                   9351:     my $output;
                   9352:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9353:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9354:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  9355:             $output = '<br />'.
                   9356:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9357:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9358:                       ' <ul>';
1.612     raeburn  9359:             foreach my $rule (@{$ruleorder}) {
                   9360:                 if (ref($curr_rules) eq 'ARRAY') {
                   9361:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9362:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9363:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9364:                                         $rules->{$rule}{'desc'}.'</li>';
                   9365:                         }
                   9366:                     }
                   9367:                 }
                   9368:             }
                   9369:             $output .= '</ul>';
                   9370:         }
                   9371:     }
                   9372:     return $output;
                   9373: }
                   9374: 
                   9375: sub instrule_disallow_msg {
1.615     raeburn  9376:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9377:     my $response;
                   9378:     my %text = (
                   9379:                   item   => 'username',
                   9380:                   items  => 'usernames',
                   9381:                   match  => 'matches',
                   9382:                   do     => 'does',
                   9383:                   action => 'a username',
                   9384:                   one    => 'one',
                   9385:                );
                   9386:     if ($count > 1) {
                   9387:         $text{'item'} = 'usernames';
                   9388:         $text{'match'} ='match';
                   9389:         $text{'do'} = 'do';
                   9390:         $text{'action'} = 'usernames',
                   9391:         $text{'one'} = 'ones';
                   9392:     }
                   9393:     if ($checkitem eq 'id') {
                   9394:         $text{'items'} = 'IDs';
                   9395:         $text{'item'} = 'ID';
                   9396:         $text{'action'} = 'an ID';
1.615     raeburn  9397:         if ($count > 1) {
                   9398:             $text{'item'} = 'IDs';
                   9399:             $text{'action'} = 'IDs';
                   9400:         }
1.612     raeburn  9401:     }
1.674     bisitz   9402:     $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  9403:     if ($mode eq 'upload') {
                   9404:         if ($checkitem eq 'username') {
                   9405:             $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'}.");
                   9406:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9407:             $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  9408:         }
1.669     raeburn  9409:     } elsif ($mode eq 'selfcreate') {
                   9410:         if ($checkitem eq 'id') {
                   9411:             $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.");
                   9412:         }
1.615     raeburn  9413:     } else {
                   9414:         if ($checkitem eq 'username') {
                   9415:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9416:         } elsif ($checkitem eq 'id') {
                   9417:             $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.");
                   9418:         }
1.612     raeburn  9419:     }
                   9420:     return $response;
1.585     raeburn  9421: }
                   9422: 
1.624     raeburn  9423: sub personal_data_fieldtitles {
                   9424:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9425:                         id => 'Student/Employee ID',
                   9426:                         permanentemail => 'E-mail address',
                   9427:                         lastname => 'Last Name',
                   9428:                         firstname => 'First Name',
                   9429:                         middlename => 'Middle Name',
                   9430:                         generation => 'Generation',
                   9431:                         gen => 'Generation',
1.765     raeburn  9432:                         inststatus => 'Affiliation',
1.624     raeburn  9433:                    );
                   9434:     return %fieldtitles;
                   9435: }
                   9436: 
1.642     raeburn  9437: sub sorted_inst_types {
                   9438:     my ($dom) = @_;
1.1075.2.70  raeburn  9439:     my ($usertypes,$order);
                   9440:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   9441:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   9442:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   9443:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   9444:     } else {
                   9445:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9446:     }
1.642     raeburn  9447:     my $othertitle = &mt('All users');
                   9448:     if ($env{'request.course.id'}) {
1.668     raeburn  9449:         $othertitle  = &mt('Any users');
1.642     raeburn  9450:     }
                   9451:     my @types;
                   9452:     if (ref($order) eq 'ARRAY') {
                   9453:         @types = @{$order};
                   9454:     }
                   9455:     if (@types == 0) {
                   9456:         if (ref($usertypes) eq 'HASH') {
                   9457:             @types = sort(keys(%{$usertypes}));
                   9458:         }
                   9459:     }
                   9460:     if (keys(%{$usertypes}) > 0) {
                   9461:         $othertitle = &mt('Other users');
                   9462:     }
                   9463:     return ($othertitle,$usertypes,\@types);
                   9464: }
                   9465: 
1.645     raeburn  9466: sub get_institutional_codes {
                   9467:     my ($settings,$allcourses,$LC_code) = @_;
                   9468: # Get complete list of course sections to update
                   9469:     my @currsections = ();
                   9470:     my @currxlists = ();
                   9471:     my $coursecode = $$settings{'internal.coursecode'};
                   9472: 
                   9473:     if ($$settings{'internal.sectionnums'} ne '') {
                   9474:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9475:     }
                   9476: 
                   9477:     if ($$settings{'internal.crosslistings'} ne '') {
                   9478:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9479:     }
                   9480: 
                   9481:     if (@currxlists > 0) {
                   9482:         foreach (@currxlists) {
                   9483:             if (m/^([^:]+):(\w*)$/) {
                   9484:                 unless (grep/^$1$/,@{$allcourses}) {
                   9485:                     push @{$allcourses},$1;
                   9486:                     $$LC_code{$1} = $2;
                   9487:                 }
                   9488:             }
                   9489:         }
                   9490:     }
                   9491:  
                   9492:     if (@currsections > 0) {
                   9493:         foreach (@currsections) {
                   9494:             if (m/^(\w+):(\w*)$/) {
                   9495:                 my $sec = $coursecode.$1;
                   9496:                 my $lc_sec = $2;
                   9497:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9498:                     push @{$allcourses},$sec;
                   9499:                     $$LC_code{$sec} = $lc_sec;
                   9500:                 }
                   9501:             }
                   9502:         }
                   9503:     }
                   9504:     return;
                   9505: }
                   9506: 
1.971     raeburn  9507: sub get_standard_codeitems {
                   9508:     return ('Year','Semester','Department','Number','Section');
                   9509: }
                   9510: 
1.112     bowersj2 9511: =pod
                   9512: 
1.780     raeburn  9513: =head1 Slot Helpers
                   9514: 
                   9515: =over 4
                   9516: 
                   9517: =item * sorted_slots()
                   9518: 
1.1040    raeburn  9519: Sorts an array of slot names in order of an optional sort key,
                   9520: default sort is by slot start time (earliest first). 
1.780     raeburn  9521: 
                   9522: Inputs:
                   9523: 
                   9524: =over 4
                   9525: 
                   9526: slotsarr  - Reference to array of unsorted slot names.
                   9527: 
                   9528: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9529: 
1.1040    raeburn  9530: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9531: 
1.549     albertel 9532: =back
                   9533: 
1.780     raeburn  9534: Returns:
                   9535: 
                   9536: =over 4
                   9537: 
1.1040    raeburn  9538: sorted   - An array of slot names sorted by a specified sort key 
                   9539:            (default sort key is start time of the slot).
1.780     raeburn  9540: 
                   9541: =back
                   9542: 
                   9543: =cut
                   9544: 
                   9545: 
                   9546: sub sorted_slots {
1.1040    raeburn  9547:     my ($slotsarr,$slots,$sortkey) = @_;
                   9548:     if ($sortkey eq '') {
                   9549:         $sortkey = 'starttime';
                   9550:     }
1.780     raeburn  9551:     my @sorted;
                   9552:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9553:         @sorted =
                   9554:             sort {
                   9555:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9556:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9557:                      }
                   9558:                      if (ref($slots->{$a})) { return -1;}
                   9559:                      if (ref($slots->{$b})) { return 1;}
                   9560:                      return 0;
                   9561:                  } @{$slotsarr};
                   9562:     }
                   9563:     return @sorted;
                   9564: }
                   9565: 
1.1040    raeburn  9566: =pod
                   9567: 
                   9568: =item * get_future_slots()
                   9569: 
                   9570: Inputs:
                   9571: 
                   9572: =over 4
                   9573: 
                   9574: cnum - course number
                   9575: 
                   9576: cdom - course domain
                   9577: 
                   9578: now - current UNIX time
                   9579: 
                   9580: symb - optional symb
                   9581: 
                   9582: =back
                   9583: 
                   9584: Returns:
                   9585: 
                   9586: =over 4
                   9587: 
                   9588: sorted_reservable - ref to array of student_schedulable slots currently 
                   9589:                     reservable, ordered by end date of reservation period.
                   9590: 
                   9591: reservable_now - ref to hash of student_schedulable slots currently
                   9592:                  reservable.
                   9593: 
                   9594:     Keys in inner hash are:
                   9595:     (a) symb: either blank or symb to which slot use is restricted.
                   9596:     (b) endreserve: end date of reservation period. 
                   9597: 
                   9598: sorted_future - ref to array of student_schedulable slots reservable in
                   9599:                 the future, ordered by start date of reservation period.
                   9600: 
                   9601: future_reservable - ref to hash of student_schedulable slots reservable
                   9602:                     in the future.
                   9603: 
                   9604:     Keys in inner hash are:
                   9605:     (a) symb: either blank or symb to which slot use is restricted.
                   9606:     (b) startreserve:  start date of reservation period.
                   9607: 
                   9608: =back
                   9609: 
                   9610: =cut
                   9611: 
                   9612: sub get_future_slots {
                   9613:     my ($cnum,$cdom,$now,$symb) = @_;
                   9614:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9615:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9616:     foreach my $slot (keys(%slots)) {
                   9617:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9618:         if ($symb) {
                   9619:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9620:                      ($slots{$slot}->{'symb'} ne $symb));
                   9621:         }
                   9622:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9623:             ($slots{$slot}->{'endtime'} > $now)) {
                   9624:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9625:                 my $userallowed = 0;
                   9626:                 if ($slots{$slot}->{'allowedsections'}) {
                   9627:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9628:                     if (!defined($env{'request.role.sec'})
                   9629:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9630:                         $userallowed=1;
                   9631:                     } else {
                   9632:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9633:                             $userallowed=1;
                   9634:                         }
                   9635:                     }
                   9636:                     unless ($userallowed) {
                   9637:                         if (defined($env{'request.course.groups'})) {
                   9638:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9639:                             foreach my $group (@groups) {
                   9640:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9641:                                     $userallowed=1;
                   9642:                                     last;
                   9643:                                 }
                   9644:                             }
                   9645:                         }
                   9646:                     }
                   9647:                 }
                   9648:                 if ($slots{$slot}->{'allowedusers'}) {
                   9649:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9650:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9651:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9652:                         $userallowed = 1;
                   9653:                     }
                   9654:                 }
                   9655:                 next unless($userallowed);
                   9656:             }
                   9657:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9658:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9659:             my $symb = $slots{$slot}->{'symb'};
                   9660:             if (($startreserve < $now) &&
                   9661:                 (!$endreserve || $endreserve > $now)) {
                   9662:                 my $lastres = $endreserve;
                   9663:                 if (!$lastres) {
                   9664:                     $lastres = $slots{$slot}->{'starttime'};
                   9665:                 }
                   9666:                 $reservable_now{$slot} = {
                   9667:                                            symb       => $symb,
                   9668:                                            endreserve => $lastres
                   9669:                                          };
                   9670:             } elsif (($startreserve > $now) &&
                   9671:                      (!$endreserve || $endreserve > $startreserve)) {
                   9672:                 $future_reservable{$slot} = {
                   9673:                                               symb         => $symb,
                   9674:                                               startreserve => $startreserve
                   9675:                                             };
                   9676:             }
                   9677:         }
                   9678:     }
                   9679:     my @unsorted_reservable = keys(%reservable_now);
                   9680:     if (@unsorted_reservable > 0) {
                   9681:         @sorted_reservable = 
                   9682:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9683:     }
                   9684:     my @unsorted_future = keys(%future_reservable);
                   9685:     if (@unsorted_future > 0) {
                   9686:         @sorted_future =
                   9687:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9688:     }
                   9689:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9690: }
1.780     raeburn  9691: 
                   9692: =pod
                   9693: 
1.1057    foxr     9694: =back
                   9695: 
1.549     albertel 9696: =head1 HTTP Helpers
                   9697: 
                   9698: =over 4
                   9699: 
1.648     raeburn  9700: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9701: 
1.258     albertel 9702: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9703: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9704: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9705: 
                   9706: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9707: $possible_names is an ref to an array of form element names.  As an example:
                   9708: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9709: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9710: 
                   9711: =cut
1.1       albertel 9712: 
1.6       albertel 9713: sub get_unprocessed_cgi {
1.25      albertel 9714:   my ($query,$possible_names)= @_;
1.26      matthew  9715:   # $Apache::lonxml::debug=1;
1.356     albertel 9716:   foreach my $pair (split(/&/,$query)) {
                   9717:     my ($name, $value) = split(/=/,$pair);
1.369     www      9718:     $name = &unescape($name);
1.25      albertel 9719:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9720:       $value =~ tr/+/ /;
                   9721:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9722:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9723:     }
1.16      harris41 9724:   }
1.6       albertel 9725: }
                   9726: 
1.112     bowersj2 9727: =pod
                   9728: 
1.648     raeburn  9729: =item * &cacheheader() 
1.112     bowersj2 9730: 
                   9731: returns cache-controlling header code
                   9732: 
                   9733: =cut
                   9734: 
1.7       albertel 9735: sub cacheheader {
1.258     albertel 9736:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9737:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9738:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9739:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9740:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9741:     return $output;
1.7       albertel 9742: }
                   9743: 
1.112     bowersj2 9744: =pod
                   9745: 
1.648     raeburn  9746: =item * &no_cache($r) 
1.112     bowersj2 9747: 
                   9748: specifies header code to not have cache
                   9749: 
                   9750: =cut
                   9751: 
1.9       albertel 9752: sub no_cache {
1.216     albertel 9753:     my ($r) = @_;
                   9754:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9755: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9756:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9757:     $r->no_cache(1);
                   9758:     $r->header_out("Expires" => $date);
                   9759:     $r->header_out("Pragma" => "no-cache");
1.123     www      9760: }
                   9761: 
                   9762: sub content_type {
1.181     albertel 9763:     my ($r,$type,$charset) = @_;
1.299     foxr     9764:     if ($r) {
                   9765: 	#  Note that printout.pl calls this with undef for $r.
                   9766: 	&no_cache($r);
                   9767:     }
1.258     albertel 9768:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9769:     unless ($charset) {
                   9770: 	$charset=&Apache::lonlocal::current_encoding;
                   9771:     }
                   9772:     if ($charset) { $type.='; charset='.$charset; }
                   9773:     if ($r) {
                   9774: 	$r->content_type($type);
                   9775:     } else {
                   9776: 	print("Content-type: $type\n\n");
                   9777:     }
1.9       albertel 9778: }
1.25      albertel 9779: 
1.112     bowersj2 9780: =pod
                   9781: 
1.648     raeburn  9782: =item * &add_to_env($name,$value) 
1.112     bowersj2 9783: 
1.258     albertel 9784: adds $name to the %env hash with value
1.112     bowersj2 9785: $value, if $name already exists, the entry is converted to an array
                   9786: reference and $value is added to the array.
                   9787: 
                   9788: =cut
                   9789: 
1.25      albertel 9790: sub add_to_env {
                   9791:   my ($name,$value)=@_;
1.258     albertel 9792:   if (defined($env{$name})) {
                   9793:     if (ref($env{$name})) {
1.25      albertel 9794:       #already have multiple values
1.258     albertel 9795:       push(@{ $env{$name} },$value);
1.25      albertel 9796:     } else {
                   9797:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9798:       my $first=$env{$name};
                   9799:       undef($env{$name});
                   9800:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9801:     }
                   9802:   } else {
1.258     albertel 9803:     $env{$name}=$value;
1.25      albertel 9804:   }
1.31      albertel 9805: }
1.149     albertel 9806: 
                   9807: =pod
                   9808: 
1.648     raeburn  9809: =item * &get_env_multiple($name) 
1.149     albertel 9810: 
1.258     albertel 9811: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9812: values may be defined and end up as an array ref.
                   9813: 
                   9814: returns an array of values
                   9815: 
                   9816: =cut
                   9817: 
                   9818: sub get_env_multiple {
                   9819:     my ($name) = @_;
                   9820:     my @values;
1.258     albertel 9821:     if (defined($env{$name})) {
1.149     albertel 9822:         # exists is it an array
1.258     albertel 9823:         if (ref($env{$name})) {
                   9824:             @values=@{ $env{$name} };
1.149     albertel 9825:         } else {
1.258     albertel 9826:             $values[0]=$env{$name};
1.149     albertel 9827:         }
                   9828:     }
                   9829:     return(@values);
                   9830: }
                   9831: 
1.660     raeburn  9832: sub ask_for_embedded_content {
                   9833:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9834:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  9835:         %currsubfile,%unused,$rem);
1.1071    raeburn  9836:     my $counter = 0;
                   9837:     my $numnew = 0;
1.987     raeburn  9838:     my $numremref = 0;
                   9839:     my $numinvalid = 0;
                   9840:     my $numpathchg = 0;
                   9841:     my $numexisting = 0;
1.1071    raeburn  9842:     my $numunused = 0;
                   9843:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53  raeburn  9844:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  9845:     my $heading = &mt('Upload embedded files');
                   9846:     my $buttontext = &mt('Upload');
                   9847: 
1.1075.2.11  raeburn  9848:     if ($env{'request.course.id'}) {
1.1075.2.35  raeburn  9849:         if ($actionurl eq '/adm/dependencies') {
                   9850:             $navmap = Apache::lonnavmaps::navmap->new();
                   9851:         }
                   9852:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9853:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11  raeburn  9854:     }
1.1075.2.35  raeburn  9855:     if (($actionurl eq '/adm/portfolio') ||
                   9856:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  9857:         my $current_path='/';
                   9858:         if ($env{'form.currentpath'}) {
                   9859:             $current_path = $env{'form.currentpath'};
                   9860:         }
                   9861:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35  raeburn  9862:             $udom = $cdom;
                   9863:             $uname = $cnum;
1.984     raeburn  9864:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9865:         } else {
                   9866:             $udom = $env{'user.domain'};
                   9867:             $uname = $env{'user.name'};
                   9868:             $url = '/userfiles/portfolio';
                   9869:         }
1.987     raeburn  9870:         $toplevel = $url.'/';
1.984     raeburn  9871:         $url .= $current_path;
                   9872:         $getpropath = 1;
1.987     raeburn  9873:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9874:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9875:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9876:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9877:         $toplevel = $url;
1.984     raeburn  9878:         if ($rest ne '') {
1.987     raeburn  9879:             $url .= $rest;
                   9880:         }
                   9881:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9882:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9883:             $url = $args->{'docs_url'};
                   9884:             $toplevel = $url;
1.1075.2.11  raeburn  9885:             if ($args->{'context'} eq 'paste') {
                   9886:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9887:                 ($path) =
                   9888:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9889:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9890:                 $fileloc =~ s{^/}{};
                   9891:             }
1.1071    raeburn  9892:         }
                   9893:     } elsif ($actionurl eq '/adm/dependencies') {
                   9894:         if ($env{'request.course.id'} ne '') {
                   9895:             if (ref($args) eq 'HASH') {
                   9896:                 $url = $args->{'docs_url'};
                   9897:                 $title = $args->{'docs_title'};
1.1075.2.35  raeburn  9898:                 $toplevel = $url;
                   9899:                 unless ($toplevel =~ m{^/}) {
                   9900:                     $toplevel = "/$url";
                   9901:                 }
1.1075.2.11  raeburn  9902:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35  raeburn  9903:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   9904:                     $path = $1;
                   9905:                 } else {
                   9906:                     ($path) =
                   9907:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9908:                 }
1.1075.2.79  raeburn  9909:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   9910:                     $fileloc = $toplevel;
                   9911:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   9912:                     my ($udom,$uname,$fname) =
                   9913:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   9914:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   9915:                 } else {
                   9916:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9917:                 }
1.1071    raeburn  9918:                 $fileloc =~ s{^/}{};
                   9919:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9920:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9921:             }
1.987     raeburn  9922:         }
1.1075.2.35  raeburn  9923:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9924:         $udom = $cdom;
                   9925:         $uname = $cnum;
                   9926:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   9927:         $toplevel = $url;
                   9928:         $path = $url;
                   9929:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   9930:         $fileloc =~ s{^/}{};
                   9931:     }
                   9932:     foreach my $file (keys(%{$allfiles})) {
                   9933:         my $embed_file;
                   9934:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   9935:             $embed_file = $1;
                   9936:         } else {
                   9937:             $embed_file = $file;
                   9938:         }
1.1075.2.55  raeburn  9939:         my ($absolutepath,$cleaned_file);
                   9940:         if ($embed_file =~ m{^\w+://}) {
                   9941:             $cleaned_file = $embed_file;
1.1075.2.47  raeburn  9942:             $newfiles{$cleaned_file} = 1;
                   9943:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9944:         } else {
1.1075.2.55  raeburn  9945:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  9946:             if ($embed_file =~ m{^/}) {
                   9947:                 $absolutepath = $embed_file;
                   9948:             }
1.1075.2.47  raeburn  9949:             if ($cleaned_file =~ m{/}) {
                   9950:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  9951:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9952:                 my $item = $fname;
                   9953:                 if ($path ne '') {
                   9954:                     $item = $path.'/'.$fname;
                   9955:                     $subdependencies{$path}{$fname} = 1;
                   9956:                 } else {
                   9957:                     $dependencies{$item} = 1;
                   9958:                 }
                   9959:                 if ($absolutepath) {
                   9960:                     $mapping{$item} = $absolutepath;
                   9961:                 } else {
                   9962:                     $mapping{$item} = $embed_file;
                   9963:                 }
                   9964:             } else {
                   9965:                 $dependencies{$embed_file} = 1;
                   9966:                 if ($absolutepath) {
1.1075.2.47  raeburn  9967:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  9968:                 } else {
1.1075.2.47  raeburn  9969:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9970:                 }
                   9971:             }
1.984     raeburn  9972:         }
                   9973:     }
1.1071    raeburn  9974:     my $dirptr = 16384;
1.984     raeburn  9975:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9976:         $currsubfile{$path} = {};
1.1075.2.35  raeburn  9977:         if (($actionurl eq '/adm/portfolio') ||
                   9978:             ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  9979:             my ($sublistref,$listerror) =
                   9980:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9981:             if (ref($sublistref) eq 'ARRAY') {
                   9982:                 foreach my $line (@{$sublistref}) {
                   9983:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9984:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9985:                 }
1.984     raeburn  9986:             }
1.987     raeburn  9987:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9988:             if (opendir(my $dir,$url.'/'.$path)) {
                   9989:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9990:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9991:             }
1.1075.2.11  raeburn  9992:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9993:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  9994:                   ($args->{'context'} eq 'paste')) ||
                   9995:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  9996:             if ($env{'request.course.id'} ne '') {
1.1075.2.35  raeburn  9997:                 my $dir;
                   9998:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9999:                     $dir = $fileloc;
                   10000:                 } else {
                   10001:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10002:                 }
1.1071    raeburn  10003:                 if ($dir ne '') {
                   10004:                     my ($sublistref,$listerror) =
                   10005:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   10006:                     if (ref($sublistref) eq 'ARRAY') {
                   10007:                         foreach my $line (@{$sublistref}) {
                   10008:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   10009:                                 undef,$mtime)=split(/\&/,$line,12);
                   10010:                             unless (($testdir&$dirptr) ||
                   10011:                                     ($file_name =~ /^\.\.?$/)) {
                   10012:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   10013:                             }
                   10014:                         }
                   10015:                     }
                   10016:                 }
1.984     raeburn  10017:             }
                   10018:         }
                   10019:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  10020:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  10021:                 my $item = $path.'/'.$file;
                   10022:                 unless ($mapping{$item} eq $item) {
                   10023:                     $pathchanges{$item} = 1;
                   10024:                 }
                   10025:                 $existing{$item} = 1;
                   10026:                 $numexisting ++;
                   10027:             } else {
                   10028:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10029:             }
                   10030:         }
1.1071    raeburn  10031:         if ($actionurl eq '/adm/dependencies') {
                   10032:             foreach my $path (keys(%currsubfile)) {
                   10033:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10034:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10035:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  10036:                              next if (($rem ne '') &&
                   10037:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10038:                                        (ref($navmap) &&
                   10039:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10040:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10041:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10042:                              $unused{$path.'/'.$file} = 1; 
                   10043:                          }
                   10044:                     }
                   10045:                 }
                   10046:             }
                   10047:         }
1.984     raeburn  10048:     }
1.987     raeburn  10049:     my %currfile;
1.1075.2.35  raeburn  10050:     if (($actionurl eq '/adm/portfolio') ||
                   10051:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10052:         my ($dirlistref,$listerror) =
                   10053:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10054:         if (ref($dirlistref) eq 'ARRAY') {
                   10055:             foreach my $line (@{$dirlistref}) {
                   10056:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10057:                 $currfile{$file_name} = 1;
                   10058:             }
1.984     raeburn  10059:         }
1.987     raeburn  10060:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10061:         if (opendir(my $dir,$url)) {
1.987     raeburn  10062:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10063:             map {$currfile{$_} = 1;} @dir_list;
                   10064:         }
1.1075.2.11  raeburn  10065:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10066:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  10067:               ($args->{'context'} eq 'paste')) ||
                   10068:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10069:         if ($env{'request.course.id'} ne '') {
                   10070:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10071:             if ($dir ne '') {
                   10072:                 my ($dirlistref,$listerror) =
                   10073:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10074:                 if (ref($dirlistref) eq 'ARRAY') {
                   10075:                     foreach my $line (@{$dirlistref}) {
                   10076:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10077:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10078:                         unless (($testdir&$dirptr) ||
                   10079:                                 ($file_name =~ /^\.\.?$/)) {
                   10080:                             $currfile{$file_name} = [$size,$mtime];
                   10081:                         }
                   10082:                     }
                   10083:                 }
                   10084:             }
                   10085:         }
1.984     raeburn  10086:     }
                   10087:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10088:         if (exists($currfile{$file})) {
1.987     raeburn  10089:             unless ($mapping{$file} eq $file) {
                   10090:                 $pathchanges{$file} = 1;
                   10091:             }
                   10092:             $existing{$file} = 1;
                   10093:             $numexisting ++;
                   10094:         } else {
1.984     raeburn  10095:             $newfiles{$file} = 1;
                   10096:         }
                   10097:     }
1.1071    raeburn  10098:     foreach my $file (keys(%currfile)) {
                   10099:         unless (($file eq $filename) ||
                   10100:                 ($file eq $filename.'.bak') ||
                   10101:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  10102:             if ($actionurl eq '/adm/dependencies') {
1.1075.2.35  raeburn  10103:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10104:                     next if (($rem ne '') &&
                   10105:                              (($env{"httpref.$rem".$file} ne '') ||
                   10106:                               (ref($navmap) &&
                   10107:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10108:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10109:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10110:                 }
1.1075.2.11  raeburn  10111:             }
1.1071    raeburn  10112:             $unused{$file} = 1;
                   10113:         }
                   10114:     }
1.1075.2.11  raeburn  10115:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10116:         ($args->{'context'} eq 'paste')) {
                   10117:         $counter = scalar(keys(%existing));
                   10118:         $numpathchg = scalar(keys(%pathchanges));
                   10119:         return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35  raeburn  10120:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
                   10121:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10122:         $counter = scalar(keys(%existing));
                   10123:         $numpathchg = scalar(keys(%pathchanges));
                   10124:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11  raeburn  10125:     }
1.984     raeburn  10126:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10127:         if ($actionurl eq '/adm/dependencies') {
                   10128:             next if ($embed_file =~ m{^\w+://});
                   10129:         }
1.660     raeburn  10130:         $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10131:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10132:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10133:         unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35  raeburn  10134:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10135:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10136:         }
1.1075.2.35  raeburn  10137:         $upload_output .= '</td>';
1.1071    raeburn  10138:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1075.2.35  raeburn  10139:             $upload_output.='<td align="right">'.
                   10140:                             '<span class="LC_info LC_fontsize_medium">'.
                   10141:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10142:             $numremref++;
1.660     raeburn  10143:         } elsif ($args->{'error_on_invalid_names'}
                   10144:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35  raeburn  10145:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10146:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10147:             $numinvalid++;
1.660     raeburn  10148:         } else {
1.1075.2.35  raeburn  10149:             $upload_output .= '<td>'.
                   10150:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10151:                                                      $embed_file,\%mapping,
1.1071    raeburn  10152:                                                      $allfiles,$codebase,'upload');
                   10153:             $counter ++;
                   10154:             $numnew ++;
1.987     raeburn  10155:         }
                   10156:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10157:     }
                   10158:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10159:         if ($actionurl eq '/adm/dependencies') {
                   10160:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10161:             $modify_output .= &start_data_table_row().
                   10162:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10163:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10164:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10165:                               '<td>'.$size.'</td>'.
                   10166:                               '<td>'.$mtime.'</td>'.
                   10167:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10168:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10169:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10170:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10171:                               &embedded_file_element('upload_embedded',$counter,
                   10172:                                                      $embed_file,\%mapping,
                   10173:                                                      $allfiles,$codebase,'modify').
                   10174:                               '</div></td>'.
                   10175:                               &end_data_table_row()."\n";
                   10176:             $counter ++;
                   10177:         } else {
                   10178:             $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10179:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10180:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10181:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10182:                               &Apache::loncommon::end_data_table_row()."\n";
                   10183:         }
                   10184:     }
                   10185:     my $delidx = $counter;
                   10186:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10187:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10188:         $delete_output .= &start_data_table_row().
                   10189:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10190:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10191:                           '<td>'.$size.'</td>'.
                   10192:                           '<td>'.$mtime.'</td>'.
                   10193:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10194:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10195:                           &embedded_file_element('upload_embedded',$delidx,
                   10196:                                                  $oldfile,\%mapping,$allfiles,
                   10197:                                                  $codebase,'delete').'</td>'.
                   10198:                           &end_data_table_row()."\n"; 
                   10199:         $numunused ++;
                   10200:         $delidx ++;
1.987     raeburn  10201:     }
                   10202:     if ($upload_output) {
                   10203:         $upload_output = &start_data_table().
                   10204:                          $upload_output.
                   10205:                          &end_data_table()."\n";
                   10206:     }
1.1071    raeburn  10207:     if ($modify_output) {
                   10208:         $modify_output = &start_data_table().
                   10209:                          &start_data_table_header_row().
                   10210:                          '<th>'.&mt('File').'</th>'.
                   10211:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10212:                          '<th>'.&mt('Modified').'</th>'.
                   10213:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10214:                          &end_data_table_header_row().
                   10215:                          $modify_output.
                   10216:                          &end_data_table()."\n";
                   10217:     }
                   10218:     if ($delete_output) {
                   10219:         $delete_output = &start_data_table().
                   10220:                          &start_data_table_header_row().
                   10221:                          '<th>'.&mt('File').'</th>'.
                   10222:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10223:                          '<th>'.&mt('Modified').'</th>'.
                   10224:                          '<th>'.&mt('Delete?').'</th>'.
                   10225:                          &end_data_table_header_row().
                   10226:                          $delete_output.
                   10227:                          &end_data_table()."\n";
                   10228:     }
1.987     raeburn  10229:     my $applies = 0;
                   10230:     if ($numremref) {
                   10231:         $applies ++;
                   10232:     }
                   10233:     if ($numinvalid) {
                   10234:         $applies ++;
                   10235:     }
                   10236:     if ($numexisting) {
                   10237:         $applies ++;
                   10238:     }
1.1071    raeburn  10239:     if ($counter || $numunused) {
1.987     raeburn  10240:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10241:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10242:                   $state.'<h3>'.$heading.'</h3>'; 
                   10243:         if ($actionurl eq '/adm/dependencies') {
                   10244:             if ($numnew) {
                   10245:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10246:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10247:                            $upload_output.'<br />'."\n";
                   10248:             }
                   10249:             if ($numexisting) {
                   10250:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10251:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10252:                            $modify_output.'<br />'."\n";
                   10253:                            $buttontext = &mt('Save changes');
                   10254:             }
                   10255:             if ($numunused) {
                   10256:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10257:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10258:                            $delete_output.'<br />'."\n";
                   10259:                            $buttontext = &mt('Save changes');
                   10260:             }
                   10261:         } else {
                   10262:             $output .= $upload_output.'<br />'."\n";
                   10263:         }
                   10264:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10265:                    $counter.'" />'."\n";
                   10266:         if ($actionurl eq '/adm/dependencies') { 
                   10267:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10268:                        $numnew.'" />'."\n";
                   10269:         } elsif ($actionurl eq '') {
1.987     raeburn  10270:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10271:         }
                   10272:     } elsif ($applies) {
                   10273:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10274:         if ($applies > 1) {
                   10275:             $output .=  
1.1075.2.35  raeburn  10276:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10277:             if ($numremref) {
                   10278:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10279:             }
                   10280:             if ($numinvalid) {
                   10281:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10282:             }
                   10283:             if ($numexisting) {
                   10284:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10285:             }
                   10286:             $output .= '</ul><br />';
                   10287:         } elsif ($numremref) {
                   10288:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10289:         } elsif ($numinvalid) {
                   10290:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10291:         } elsif ($numexisting) {
                   10292:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10293:         }
                   10294:         $output .= $upload_output.'<br />';
                   10295:     }
                   10296:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10297:     $chgcount = $counter;
1.987     raeburn  10298:     if (keys(%pathchanges) > 0) {
                   10299:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10300:             if ($counter) {
1.987     raeburn  10301:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10302:                                                   $embed_file,\%mapping,
1.1071    raeburn  10303:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10304:             } else {
                   10305:                 $pathchange_output .= 
                   10306:                     &start_data_table_row().
                   10307:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10308:                     $chgcount.'" checked="checked" /></td>'.
                   10309:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10310:                     '<td>'.$embed_file.
                   10311:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10312:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10313:                     '</td>'.&end_data_table_row();
1.660     raeburn  10314:             }
1.987     raeburn  10315:             $numpathchg ++;
                   10316:             $chgcount ++;
1.660     raeburn  10317:         }
                   10318:     }
1.1075.2.35  raeburn  10319:     if (($counter) || ($numunused)) {
1.987     raeburn  10320:         if ($numpathchg) {
                   10321:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10322:                        $numpathchg.'" />'."\n";
                   10323:         }
                   10324:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10325:             ($actionurl eq '/adm/imsimport')) {
                   10326:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10327:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10328:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10329:         } elsif ($actionurl eq '/adm/dependencies') {
                   10330:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10331:         }
1.1075.2.35  raeburn  10332:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10333:     } elsif ($numpathchg) {
                   10334:         my %pathchange = ();
                   10335:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10336:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10337:             $output .= '<p>'.&mt('or').'</p>'; 
1.1075.2.35  raeburn  10338:         }
1.987     raeburn  10339:     }
1.1071    raeburn  10340:     return ($output,$counter,$numpathchg);
1.987     raeburn  10341: }
                   10342: 
1.1075.2.47  raeburn  10343: =pod
                   10344: 
                   10345: =item * clean_path($name)
                   10346: 
                   10347: Performs clean-up of directories, subdirectories and filename in an
                   10348: embedded object, referenced in an HTML file which is being uploaded
                   10349: to a course or portfolio, where
                   10350: "Upload embedded images/multimedia files if HTML file" checkbox was
                   10351: checked.
                   10352: 
                   10353: Clean-up is similar to replacements in lonnet::clean_filename()
                   10354: except each / between sub-directory and next level is preserved.
                   10355: 
                   10356: =cut
                   10357: 
                   10358: sub clean_path {
                   10359:     my ($embed_file) = @_;
                   10360:     $embed_file =~s{^/+}{};
                   10361:     my @contents;
                   10362:     if ($embed_file =~ m{/}) {
                   10363:         @contents = split(/\//,$embed_file);
                   10364:     } else {
                   10365:         @contents = ($embed_file);
                   10366:     }
                   10367:     my $lastidx = scalar(@contents)-1;
                   10368:     for (my $i=0; $i<=$lastidx; $i++) {
                   10369:         $contents[$i]=~s{\\}{/}g;
                   10370:         $contents[$i]=~s/\s+/\_/g;
                   10371:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   10372:         if ($i == $lastidx) {
                   10373:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   10374:         }
                   10375:     }
                   10376:     if ($lastidx > 0) {
                   10377:         return join('/',@contents);
                   10378:     } else {
                   10379:         return $contents[0];
                   10380:     }
                   10381: }
                   10382: 
1.987     raeburn  10383: sub embedded_file_element {
1.1071    raeburn  10384:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10385:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10386:                    (ref($codebase) eq 'HASH'));
                   10387:     my $output;
1.1071    raeburn  10388:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10389:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10390:     }
                   10391:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10392:                &escape($embed_file).'" />';
                   10393:     unless (($context eq 'upload_embedded') && 
                   10394:             ($mapping->{$embed_file} eq $embed_file)) {
                   10395:         $output .='
                   10396:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10397:     }
                   10398:     my $attrib;
                   10399:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10400:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10401:     }
                   10402:     $output .=
                   10403:         "\n\t\t".
                   10404:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10405:         $attrib.'" />';
                   10406:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10407:         $output .=
                   10408:             "\n\t\t".
                   10409:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10410:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10411:     }
1.987     raeburn  10412:     return $output;
1.660     raeburn  10413: }
                   10414: 
1.1071    raeburn  10415: sub get_dependency_details {
                   10416:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10417:     my ($size,$mtime,$showsize,$showmtime);
                   10418:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10419:         if ($embed_file =~ m{/}) {
                   10420:             my ($path,$fname) = split(/\//,$embed_file);
                   10421:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10422:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10423:             }
                   10424:         } else {
                   10425:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10426:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10427:             }
                   10428:         }
                   10429:         $showsize = $size/1024.0;
                   10430:         $showsize = sprintf("%.1f",$showsize);
                   10431:         if ($mtime > 0) {
                   10432:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10433:         }
                   10434:     }
                   10435:     return ($showsize,$showmtime);
                   10436: }
                   10437: 
                   10438: sub ask_embedded_js {
                   10439:     return <<"END";
                   10440: <script type="text/javascript"">
                   10441: // <![CDATA[
                   10442: function toggleBrowse(counter) {
                   10443:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10444:     var fileid = document.getElementById('embedded_item_'+counter);
                   10445:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10446:     if (chkboxid.checked == true) {
                   10447:         uploaddivid.style.display='block';
                   10448:     } else {
                   10449:         uploaddivid.style.display='none';
                   10450:         fileid.value = '';
                   10451:     }
                   10452: }
                   10453: // ]]>
                   10454: </script>
                   10455: 
                   10456: END
                   10457: }
                   10458: 
1.661     raeburn  10459: sub upload_embedded {
                   10460:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10461:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10462:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10463:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10464:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10465:         my $orig_uploaded_filename =
                   10466:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10467:         foreach my $type ('orig','ref','attrib','codebase') {
                   10468:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10469:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10470:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10471:             }
                   10472:         }
1.661     raeburn  10473:         my ($path,$fname) =
                   10474:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10475:         # no path, whole string is fname
                   10476:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10477:         $fname = &Apache::lonnet::clean_filename($fname);
                   10478:         # See if there is anything left
                   10479:         next if ($fname eq '');
                   10480: 
                   10481:         # Check if file already exists as a file or directory.
                   10482:         my ($state,$msg);
                   10483:         if ($context eq 'portfolio') {
                   10484:             my $port_path = $dirpath;
                   10485:             if ($group ne '') {
                   10486:                 $port_path = "groups/$group/$port_path";
                   10487:             }
1.987     raeburn  10488:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10489:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10490:                                               $dir_root,$port_path,$disk_quota,
                   10491:                                               $current_disk_usage,$uname,$udom);
                   10492:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10493:                 || $state eq 'file_locked') {
1.661     raeburn  10494:                 $output .= $msg;
                   10495:                 next;
                   10496:             }
                   10497:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10498:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10499:             if ($state eq 'exists') {
                   10500:                 $output .= $msg;
                   10501:                 next;
                   10502:             }
                   10503:         }
                   10504:         # Check if extension is valid
                   10505:         if (($fname =~ /\.(\w+)$/) &&
                   10506:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53  raeburn  10507:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   10508:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  10509:             next;
                   10510:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10511:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10512:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10513:             next;
                   10514:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34  raeburn  10515:             $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  10516:             next;
                   10517:         }
                   10518:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35  raeburn  10519:         my $subdir = $path;
                   10520:         $subdir =~ s{/+$}{};
1.661     raeburn  10521:         if ($context eq 'portfolio') {
1.984     raeburn  10522:             my $result;
                   10523:             if ($state eq 'existingfile') {
                   10524:                 $result=
                   10525:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35  raeburn  10526:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  10527:             } else {
1.984     raeburn  10528:                 $result=
                   10529:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10530:                                                     $dirpath.
1.1075.2.35  raeburn  10531:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  10532:                 if ($result !~ m|^/uploaded/|) {
                   10533:                     $output .= '<span class="LC_error">'
                   10534:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10535:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10536:                                .'</span><br />';
                   10537:                     next;
                   10538:                 } else {
1.987     raeburn  10539:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10540:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10541:                 }
1.661     raeburn  10542:             }
1.1075.2.35  raeburn  10543:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
                   10544:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   10545:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  10546:             my $result =
1.1075.2.35  raeburn  10547:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  10548:             if ($result !~ m|^/uploaded/|) {
                   10549:                 $output .= '<span class="LC_error">'
                   10550:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10551:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10552:                            .'</span><br />';
                   10553:                     next;
                   10554:             } else {
                   10555:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10556:                            $path.$fname.'</span>').'<br />';
1.1075.2.35  raeburn  10557:                 if ($context eq 'syllabus') {
                   10558:                     &Apache::lonnet::make_public_indefinitely($result);
                   10559:                 }
1.987     raeburn  10560:             }
1.661     raeburn  10561:         } else {
                   10562: # Save the file
                   10563:             my $target = $env{'form.embedded_item_'.$i};
                   10564:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10565:             my $dest = $fullpath.$fname;
                   10566:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10567:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10568:             my $count;
                   10569:             my $filepath = $dir_root;
1.1027    raeburn  10570:             foreach my $subdir (@parts) {
                   10571:                 $filepath .= "/$subdir";
                   10572:                 if (!-e $filepath) {
1.661     raeburn  10573:                     mkdir($filepath,0770);
                   10574:                 }
                   10575:             }
                   10576:             my $fh;
                   10577:             if (!open($fh,'>'.$dest)) {
                   10578:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10579:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10580:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10581:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10582:                            '</span><br />';
                   10583:             } else {
                   10584:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10585:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10586:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10587:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10588:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10589:                               '</span><br />';
                   10590:                 } else {
1.987     raeburn  10591:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10592:                                $url.'</span>').'<br />';
                   10593:                     unless ($context eq 'testbank') {
                   10594:                         $footer .= &mt('View embedded file: [_1]',
                   10595:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10596:                     }
                   10597:                 }
                   10598:                 close($fh);
                   10599:             }
                   10600:         }
                   10601:         if ($env{'form.embedded_ref_'.$i}) {
                   10602:             $pathchange{$i} = 1;
                   10603:         }
                   10604:     }
                   10605:     if ($output) {
                   10606:         $output = '<p>'.$output.'</p>';
                   10607:     }
                   10608:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10609:     $returnflag = 'ok';
1.1071    raeburn  10610:     my $numpathchgs = scalar(keys(%pathchange));
                   10611:     if ($numpathchgs > 0) {
1.987     raeburn  10612:         if ($context eq 'portfolio') {
                   10613:             $output .= '<p>'.&mt('or').'</p>';
                   10614:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10615:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10616:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10617:             $returnflag = 'modify_orightml';
                   10618:         }
                   10619:     }
1.1071    raeburn  10620:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10621: }
                   10622: 
                   10623: sub modify_html_form {
                   10624:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10625:     my $end = 0;
                   10626:     my $modifyform;
                   10627:     if ($context eq 'upload_embedded') {
                   10628:         return unless (ref($pathchange) eq 'HASH');
                   10629:         if ($env{'form.number_embedded_items'}) {
                   10630:             $end += $env{'form.number_embedded_items'};
                   10631:         }
                   10632:         if ($env{'form.number_pathchange_items'}) {
                   10633:             $end += $env{'form.number_pathchange_items'};
                   10634:         }
                   10635:         if ($end) {
                   10636:             for (my $i=0; $i<$end; $i++) {
                   10637:                 if ($i < $env{'form.number_embedded_items'}) {
                   10638:                     next unless($pathchange->{$i});
                   10639:                 }
                   10640:                 $modifyform .=
                   10641:                     &start_data_table_row().
                   10642:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10643:                     'checked="checked" /></td>'.
                   10644:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10645:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10646:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10647:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10648:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10649:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10650:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10651:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10652:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10653:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10654:                     &end_data_table_row();
1.1071    raeburn  10655:             }
1.987     raeburn  10656:         }
                   10657:     } else {
                   10658:         $modifyform = $pathchgtable;
                   10659:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10660:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10661:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10662:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10663:         }
                   10664:     }
                   10665:     if ($modifyform) {
1.1071    raeburn  10666:         if ($actionurl eq '/adm/dependencies') {
                   10667:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10668:         }
1.987     raeburn  10669:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10670:                '<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".
                   10671:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10672:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10673:                '</ol></p>'."\n".'<p>'.
                   10674:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10675:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10676:                &start_data_table()."\n".
                   10677:                &start_data_table_header_row().
                   10678:                '<th>'.&mt('Change?').'</th>'.
                   10679:                '<th>'.&mt('Current reference').'</th>'.
                   10680:                '<th>'.&mt('Required reference').'</th>'.
                   10681:                &end_data_table_header_row()."\n".
                   10682:                $modifyform.
                   10683:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10684:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10685:                '</form>'."\n";
                   10686:     }
                   10687:     return;
                   10688: }
                   10689: 
                   10690: sub modify_html_refs {
1.1075.2.35  raeburn  10691:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  10692:     my $container;
                   10693:     if ($context eq 'portfolio') {
                   10694:         $container = $env{'form.container'};
                   10695:     } elsif ($context eq 'coursedoc') {
                   10696:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10697:     } elsif ($context eq 'manage_dependencies') {
                   10698:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10699:         $container = "/$container";
1.1075.2.35  raeburn  10700:     } elsif ($context eq 'syllabus') {
                   10701:         $container = $url;
1.987     raeburn  10702:     } else {
1.1027    raeburn  10703:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10704:     }
                   10705:     my (%allfiles,%codebase,$output,$content);
                   10706:     my @changes = &get_env_multiple('form.namechange');
1.1075.2.35  raeburn  10707:     unless ((@changes > 0)  || ($context eq 'syllabus')) {
1.1071    raeburn  10708:         if (wantarray) {
                   10709:             return ('',0,0); 
                   10710:         } else {
                   10711:             return;
                   10712:         }
                   10713:     }
                   10714:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10715:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  10716:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10717:             if (wantarray) {
                   10718:                 return ('',0,0);
                   10719:             } else {
                   10720:                 return;
                   10721:             }
                   10722:         } 
1.987     raeburn  10723:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10724:         if ($content eq '-1') {
                   10725:             if (wantarray) {
                   10726:                 return ('',0,0);
                   10727:             } else {
                   10728:                 return;
                   10729:             }
                   10730:         }
1.987     raeburn  10731:     } else {
1.1071    raeburn  10732:         unless ($container =~ /^\Q$dir_root\E/) {
                   10733:             if (wantarray) {
                   10734:                 return ('',0,0);
                   10735:             } else {
                   10736:                 return;
                   10737:             }
                   10738:         } 
1.987     raeburn  10739:         if (open(my $fh,"<$container")) {
                   10740:             $content = join('', <$fh>);
                   10741:             close($fh);
                   10742:         } else {
1.1071    raeburn  10743:             if (wantarray) {
                   10744:                 return ('',0,0);
                   10745:             } else {
                   10746:                 return;
                   10747:             }
1.987     raeburn  10748:         }
                   10749:     }
                   10750:     my ($count,$codebasecount) = (0,0);
                   10751:     my $mm = new File::MMagic;
                   10752:     my $mime_type = $mm->checktype_contents($content);
                   10753:     if ($mime_type eq 'text/html') {
                   10754:         my $parse_result = 
                   10755:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10756:                                                     \%codebase,\$content);
                   10757:         if ($parse_result eq 'ok') {
                   10758:             foreach my $i (@changes) {
                   10759:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10760:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10761:                 if ($allfiles{$ref}) {
                   10762:                     my $newname =  $orig;
                   10763:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10764:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10765:                     if ($attrib_regexp =~ /:/) {
                   10766:                         $attrib_regexp =~ s/\:/|/g;
                   10767:                     }
                   10768:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10769:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10770:                         $count += $numchg;
1.1075.2.35  raeburn  10771:                         $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48  raeburn  10772:                         delete($allfiles{$ref});
1.987     raeburn  10773:                     }
                   10774:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10775:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10776:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10777:                         $codebasecount ++;
                   10778:                     }
                   10779:                 }
                   10780:             }
1.1075.2.35  raeburn  10781:             my $skiprewrites;
1.987     raeburn  10782:             if ($count || $codebasecount) {
                   10783:                 my $saveresult;
1.1071    raeburn  10784:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10785:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  10786:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10787:                     if ($url eq $container) {
                   10788:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10789:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10790:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10791:                                             $fname.'</span>').'</p>';
1.987     raeburn  10792:                     } else {
                   10793:                          $output = '<p class="LC_error">'.
                   10794:                                    &mt('Error: update failed for: [_1].',
                   10795:                                    '<span class="LC_filename">'.
                   10796:                                    $container.'</span>').'</p>';
                   10797:                     }
1.1075.2.35  raeburn  10798:                     if ($context eq 'syllabus') {
                   10799:                         unless ($saveresult eq 'ok') {
                   10800:                             $skiprewrites = 1;
                   10801:                         }
                   10802:                     }
1.987     raeburn  10803:                 } else {
                   10804:                     if (open(my $fh,">$container")) {
                   10805:                         print $fh $content;
                   10806:                         close($fh);
                   10807:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10808:                                   $count,'<span class="LC_filename">'.
                   10809:                                   $container.'</span>').'</p>';
1.661     raeburn  10810:                     } else {
1.987     raeburn  10811:                          $output = '<p class="LC_error">'.
                   10812:                                    &mt('Error: could not update [_1].',
                   10813:                                    '<span class="LC_filename">'.
                   10814:                                    $container.'</span>').'</p>';
1.661     raeburn  10815:                     }
                   10816:                 }
                   10817:             }
1.1075.2.35  raeburn  10818:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   10819:                 my ($actionurl,$state);
                   10820:                 $actionurl = "/public/$udom/$uname/syllabus";
                   10821:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   10822:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   10823:                                               \%codebase,
                   10824:                                               {'context' => 'rewrites',
                   10825:                                                'ignore_remote_references' => 1,});
                   10826:                 if (ref($mapping) eq 'HASH') {
                   10827:                     my $rewrites = 0;
                   10828:                     foreach my $key (keys(%{$mapping})) {
                   10829:                         next if ($key =~ m{^https?://});
                   10830:                         my $ref = $mapping->{$key};
                   10831:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   10832:                         my $attrib;
                   10833:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   10834:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   10835:                         }
                   10836:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10837:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10838:                             $rewrites += $numchg;
                   10839:                         }
                   10840:                     }
                   10841:                     if ($rewrites) {
                   10842:                         my $saveresult;
                   10843:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10844:                         if ($url eq $container) {
                   10845:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   10846:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   10847:                                             $count,'<span class="LC_filename">'.
                   10848:                                             $fname.'</span>').'</p>';
                   10849:                         } else {
                   10850:                             $output .= '<p class="LC_error">'.
                   10851:                                        &mt('Error: could not update links in [_1].',
                   10852:                                        '<span class="LC_filename">'.
                   10853:                                        $container.'</span>').'</p>';
                   10854: 
                   10855:                         }
                   10856:                     }
                   10857:                 }
                   10858:             }
1.987     raeburn  10859:         } else {
                   10860:             &logthis('Failed to parse '.$container.
                   10861:                      ' to modify references: '.$parse_result);
1.661     raeburn  10862:         }
                   10863:     }
1.1071    raeburn  10864:     if (wantarray) {
                   10865:         return ($output,$count,$codebasecount);
                   10866:     } else {
                   10867:         return $output;
                   10868:     }
1.661     raeburn  10869: }
                   10870: 
                   10871: sub check_for_existing {
                   10872:     my ($path,$fname,$element) = @_;
                   10873:     my ($state,$msg);
                   10874:     if (-d $path.'/'.$fname) {
                   10875:         $state = 'exists';
                   10876:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10877:     } elsif (-e $path.'/'.$fname) {
                   10878:         $state = 'exists';
                   10879:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10880:     }
                   10881:     if ($state eq 'exists') {
                   10882:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10883:     }
                   10884:     return ($state,$msg);
                   10885: }
                   10886: 
                   10887: sub check_for_upload {
                   10888:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10889:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10890:     my $filesize = length($env{'form.'.$element});
                   10891:     if (!$filesize) {
                   10892:         my $msg = '<span class="LC_error">'.
                   10893:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10894:                       '<span class="LC_filename">'.$fname.'</span>',
                   10895:                       $filesize).'<br />'.
1.1007    raeburn  10896:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10897:                   '</span>';
                   10898:         return ('zero_bytes',$msg);
                   10899:     }
                   10900:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10901:     my $getpropath = 1;
1.1021    raeburn  10902:     my ($dirlistref,$listerror) =
                   10903:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10904:     my $found_file = 0;
                   10905:     my $locked_file = 0;
1.991     raeburn  10906:     my @lockers;
                   10907:     my $navmap;
                   10908:     if ($env{'request.course.id'}) {
                   10909:         $navmap = Apache::lonnavmaps::navmap->new();
                   10910:     }
1.1021    raeburn  10911:     if (ref($dirlistref) eq 'ARRAY') {
                   10912:         foreach my $line (@{$dirlistref}) {
                   10913:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10914:             if ($file_name eq $fname){
                   10915:                 $file_name = $path.$file_name;
                   10916:                 if ($group ne '') {
                   10917:                     $file_name = $group.$file_name;
                   10918:                 }
                   10919:                 $found_file = 1;
                   10920:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10921:                     foreach my $lock (@lockers) {
                   10922:                         if (ref($lock) eq 'ARRAY') {
                   10923:                             my ($symb,$crsid) = @{$lock};
                   10924:                             if ($crsid eq $env{'request.course.id'}) {
                   10925:                                 if (ref($navmap)) {
                   10926:                                     my $res = $navmap->getBySymb($symb);
                   10927:                                     foreach my $part (@{$res->parts()}) { 
                   10928:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10929:                                         unless (($slot_status == $res->RESERVED) ||
                   10930:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10931:                                             $locked_file = 1;
                   10932:                                         }
1.991     raeburn  10933:                                     }
1.1021    raeburn  10934:                                 } else {
                   10935:                                     $locked_file = 1;
1.991     raeburn  10936:                                 }
                   10937:                             } else {
                   10938:                                 $locked_file = 1;
                   10939:                             }
                   10940:                         }
1.1021    raeburn  10941:                    }
                   10942:                 } else {
                   10943:                     my @info = split(/\&/,$rest);
                   10944:                     my $currsize = $info[6]/1000;
                   10945:                     if ($currsize < $filesize) {
                   10946:                         my $extra = $filesize - $currsize;
                   10947:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69  raeburn  10948:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  10949:                                       &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  10950:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   10951:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10952:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  10953:                             return ('will_exceed_quota',$msg);
                   10954:                         }
1.984     raeburn  10955:                     }
                   10956:                 }
1.661     raeburn  10957:             }
                   10958:         }
                   10959:     }
                   10960:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69  raeburn  10961:         my $msg = '<p class="LC_warning">'.
                   10962:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
                   10963:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  10964:         return ('will_exceed_quota',$msg);
                   10965:     } elsif ($found_file) {
                   10966:         if ($locked_file) {
1.1075.2.69  raeburn  10967:             my $msg = '<p class="LC_warning">';
1.661     raeburn  10968:             $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  10969:             $msg .= '</p>';
1.661     raeburn  10970:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10971:             return ('file_locked',$msg);
                   10972:         } else {
1.1075.2.69  raeburn  10973:             my $msg = '<p class="LC_error">';
1.984     raeburn  10974:             $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  10975:             $msg .= '</p>';
1.984     raeburn  10976:             return ('existingfile',$msg);
1.661     raeburn  10977:         }
                   10978:     }
                   10979: }
                   10980: 
1.987     raeburn  10981: sub check_for_traversal {
                   10982:     my ($path,$url,$toplevel) = @_;
                   10983:     my @parts=split(/\//,$path);
                   10984:     my $cleanpath;
                   10985:     my $fullpath = $url;
                   10986:     for (my $i=0;$i<@parts;$i++) {
                   10987:         next if ($parts[$i] eq '.');
                   10988:         if ($parts[$i] eq '..') {
                   10989:             $fullpath =~ s{([^/]+/)$}{};
                   10990:         } else {
                   10991:             $fullpath .= $parts[$i].'/';
                   10992:         }
                   10993:     }
                   10994:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10995:         $cleanpath = $1;
                   10996:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10997:         my $curr_toprel = $1;
                   10998:         my @parts = split(/\//,$curr_toprel);
                   10999:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   11000:         my @urlparts = split(/\//,$url_toprel);
                   11001:         my $doubledots;
                   11002:         my $startdiff = -1;
                   11003:         for (my $i=0; $i<@urlparts; $i++) {
                   11004:             if ($startdiff == -1) {
                   11005:                 unless ($urlparts[$i] eq $parts[$i]) {
                   11006:                     $startdiff = $i;
                   11007:                     $doubledots .= '../';
                   11008:                 }
                   11009:             } else {
                   11010:                 $doubledots .= '../';
                   11011:             }
                   11012:         }
                   11013:         if ($startdiff > -1) {
                   11014:             $cleanpath = $doubledots;
                   11015:             for (my $i=$startdiff; $i<@parts; $i++) {
                   11016:                 $cleanpath .= $parts[$i].'/';
                   11017:             }
                   11018:         }
                   11019:     }
                   11020:     $cleanpath =~ s{(/)$}{};
                   11021:     return $cleanpath;
                   11022: }
1.31      albertel 11023: 
1.1053    raeburn  11024: sub is_archive_file {
                   11025:     my ($mimetype) = @_;
                   11026:     if (($mimetype eq 'application/octet-stream') ||
                   11027:         ($mimetype eq 'application/x-stuffit') ||
                   11028:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11029:         return 1;
                   11030:     }
                   11031:     return;
                   11032: }
                   11033: 
                   11034: sub decompress_form {
1.1065    raeburn  11035:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11036:     my %lt = &Apache::lonlocal::texthash (
                   11037:         this => 'This file is an archive file.',
1.1067    raeburn  11038:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11039:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11040:         youm => 'You may wish to extract its contents.',
                   11041:         extr => 'Extract contents',
1.1067    raeburn  11042:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11043:         proa => 'Process automatically?',
1.1053    raeburn  11044:         yes  => 'Yes',
                   11045:         no   => 'No',
1.1067    raeburn  11046:         fold => 'Title for folder containing movie',
                   11047:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11048:     );
1.1065    raeburn  11049:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11050:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11051:     my $info = &list_archive_contents($fileloc,\@paths);
                   11052:     if (@paths) {
                   11053:         foreach my $path (@paths) {
                   11054:             $path =~ s{^/}{};
1.1067    raeburn  11055:             if ($path =~ m{^([^/]+)/$}) {
                   11056:                 $topdir = $1;
                   11057:             }
1.1065    raeburn  11058:             if ($path =~ m{^([^/]+)/}) {
                   11059:                 $toplevel{$1} = $path;
                   11060:             } else {
                   11061:                 $toplevel{$path} = $path;
                   11062:             }
                   11063:         }
                   11064:     }
1.1067    raeburn  11065:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59  raeburn  11066:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11067:                         "$topdir/media/",
                   11068:                         "$topdir/media/$topdir.mp4",
                   11069:                         "$topdir/media/FirstFrame.png",
                   11070:                         "$topdir/media/player.swf",
                   11071:                         "$topdir/media/swfobject.js",
                   11072:                         "$topdir/media/expressInstall.swf");
1.1075.2.59  raeburn  11073:         my @camtasia8 = ("$topdir/","$topdir/$topdir.html",
                   11074:                          "$topdir/$topdir.mp4",
                   11075:                          "$topdir/$topdir\_config.xml",
                   11076:                          "$topdir/$topdir\_controller.swf",
                   11077:                          "$topdir/$topdir\_embed.css",
                   11078:                          "$topdir/$topdir\_First_Frame.png",
                   11079:                          "$topdir/$topdir\_player.html",
                   11080:                          "$topdir/$topdir\_Thumbnails.png",
                   11081:                          "$topdir/playerProductInstall.swf",
                   11082:                          "$topdir/scripts/",
                   11083:                          "$topdir/scripts/config_xml.js",
                   11084:                          "$topdir/scripts/handlebars.js",
                   11085:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11086:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11087:                          "$topdir/scripts/modernizr.js",
                   11088:                          "$topdir/scripts/player-min.js",
                   11089:                          "$topdir/scripts/swfobject.js",
                   11090:                          "$topdir/skins/",
                   11091:                          "$topdir/skins/configuration_express.xml",
                   11092:                          "$topdir/skins/express_show/",
                   11093:                          "$topdir/skins/express_show/player-min.css",
                   11094:                          "$topdir/skins/express_show/spritesheet.png");
                   11095:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11096:         if (@diffs == 0) {
1.1075.2.59  raeburn  11097:             $is_camtasia = 6;
                   11098:         } else {
                   11099:             @diffs = &compare_arrays(\@paths,\@camtasia8);
                   11100:             if (@diffs == 0) {
                   11101:                 $is_camtasia = 8;
                   11102:             }
1.1067    raeburn  11103:         }
                   11104:     }
                   11105:     my $output;
                   11106:     if ($is_camtasia) {
                   11107:         $output = <<"ENDCAM";
                   11108: <script type="text/javascript" language="Javascript">
                   11109: // <![CDATA[
                   11110: 
                   11111: function camtasiaToggle() {
                   11112:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11113:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59  raeburn  11114:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11115:                 document.getElementById('camtasia_titles').style.display='block';
                   11116:             } else {
                   11117:                 document.getElementById('camtasia_titles').style.display='none';
                   11118:             }
                   11119:         }
                   11120:     }
                   11121:     return;
                   11122: }
                   11123: 
                   11124: // ]]>
                   11125: </script>
                   11126: <p>$lt{'camt'}</p>
                   11127: ENDCAM
1.1065    raeburn  11128:     } else {
1.1067    raeburn  11129:         $output = '<p>'.$lt{'this'};
                   11130:         if ($info eq '') {
                   11131:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11132:         } else {
                   11133:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11134:                        '<div><pre>'.$info.'</pre></div>';
                   11135:         }
1.1065    raeburn  11136:     }
1.1067    raeburn  11137:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11138:     my $duplicates;
                   11139:     my $num = 0;
                   11140:     if (ref($dirlist) eq 'ARRAY') {
                   11141:         foreach my $item (@{$dirlist}) {
                   11142:             if (ref($item) eq 'ARRAY') {
                   11143:                 if (exists($toplevel{$item->[0]})) {
                   11144:                     $duplicates .= 
                   11145:                         &start_data_table_row().
                   11146:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11147:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11148:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11149:                         'value="1" />'.&mt('Yes').'</label>'.
                   11150:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11151:                         '<td>'.$item->[0].'</td>';
                   11152:                     if ($item->[2]) {
                   11153:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11154:                     } else {
                   11155:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11156:                     }
                   11157:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11158:                                    '<td>'.
                   11159:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11160:                                    '</td>'.
                   11161:                                    &end_data_table_row();
                   11162:                     $num ++;
                   11163:                 }
                   11164:             }
                   11165:         }
                   11166:     }
                   11167:     my $itemcount;
                   11168:     if (@paths > 0) {
                   11169:         $itemcount = scalar(@paths);
                   11170:     } else {
                   11171:         $itemcount = 1;
                   11172:     }
1.1067    raeburn  11173:     if ($is_camtasia) {
                   11174:         $output .= $lt{'auto'}.'<br />'.
                   11175:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59  raeburn  11176:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  11177:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11178:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11179:                    $lt{'no'}.'</label></span><br />'.
                   11180:                    '<div id="camtasia_titles" style="display:block">'.
                   11181:                    &Apache::lonhtmlcommon::start_pick_box().
                   11182:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11183:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11184:                    &Apache::lonhtmlcommon::row_closure().
                   11185:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11186:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11187:                    &Apache::lonhtmlcommon::row_closure(1).
                   11188:                    &Apache::lonhtmlcommon::end_pick_box().
                   11189:                    '</div>';
                   11190:     }
1.1065    raeburn  11191:     $output .= 
                   11192:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11193:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11194:         "\n";
1.1065    raeburn  11195:     if ($duplicates ne '') {
                   11196:         $output .= '<p><span class="LC_warning">'.
                   11197:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11198:                    &start_data_table().
                   11199:                    &start_data_table_header_row().
                   11200:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11201:                    '<th>'.&mt('Name').'</th>'.
                   11202:                    '<th>'.&mt('Type').'</th>'.
                   11203:                    '<th>'.&mt('Size').'</th>'.
                   11204:                    '<th>'.&mt('Last modified').'</th>'.
                   11205:                    &end_data_table_header_row().
                   11206:                    $duplicates.
                   11207:                    &end_data_table().
                   11208:                    '</p>';
                   11209:     }
1.1067    raeburn  11210:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11211:     if (ref($hiddenelements) eq 'HASH') {
                   11212:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11213:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11214:         }
                   11215:     }
                   11216:     $output .= <<"END";
1.1067    raeburn  11217: <br />
1.1053    raeburn  11218: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11219: </form>
                   11220: $noextract
                   11221: END
                   11222:     return $output;
                   11223: }
                   11224: 
1.1065    raeburn  11225: sub decompression_utility {
                   11226:     my ($program) = @_;
                   11227:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11228:     my $location;
                   11229:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11230:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11231:                          '/usr/sbin/') {
                   11232:             if (-x $dir.$program) {
                   11233:                 $location = $dir.$program;
                   11234:                 last;
                   11235:             }
                   11236:         }
                   11237:     }
                   11238:     return $location;
                   11239: }
                   11240: 
                   11241: sub list_archive_contents {
                   11242:     my ($file,$pathsref) = @_;
                   11243:     my (@cmd,$output);
                   11244:     my $needsregexp;
                   11245:     if ($file =~ /\.zip$/) {
                   11246:         @cmd = (&decompression_utility('unzip'),"-l");
                   11247:         $needsregexp = 1;
                   11248:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11249:              ($file =~ /\.tgz$/)) {
                   11250:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11251:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11252:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11253:     } elsif ($file =~ m|\.tar$|) {
                   11254:         @cmd = (&decompression_utility('tar'),"-tf");
                   11255:     }
                   11256:     if (@cmd) {
                   11257:         undef($!);
                   11258:         undef($@);
                   11259:         if (open(my $fh,"-|", @cmd, $file)) {
                   11260:             while (my $line = <$fh>) {
                   11261:                 $output .= $line;
                   11262:                 chomp($line);
                   11263:                 my $item;
                   11264:                 if ($needsregexp) {
                   11265:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11266:                 } else {
                   11267:                     $item = $line;
                   11268:                 }
                   11269:                 if ($item ne '') {
                   11270:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11271:                         push(@{$pathsref},$item);
                   11272:                     } 
                   11273:                 }
                   11274:             }
                   11275:             close($fh);
                   11276:         }
                   11277:     }
                   11278:     return $output;
                   11279: }
                   11280: 
1.1053    raeburn  11281: sub decompress_uploaded_file {
                   11282:     my ($file,$dir) = @_;
                   11283:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11284:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11285:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11286:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11287:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11288:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11289:     my $decompressed = $env{'cgi.decompressed'};
                   11290:     &Apache::lonnet::delenv('cgi.file');
                   11291:     &Apache::lonnet::delenv('cgi.dir');
                   11292:     &Apache::lonnet::delenv('cgi.decompressed');
                   11293:     return ($decompressed,$result);
                   11294: }
                   11295: 
1.1055    raeburn  11296: sub process_decompression {
                   11297:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11298:     my ($dir,$error,$warning,$output);
1.1075.2.69  raeburn  11299:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34  raeburn  11300:         $error = &mt('Filename not a supported archive file type.').
                   11301:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11302:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11303:     } else {
                   11304:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11305:         if ($docuhome eq 'no_host') {
                   11306:             $error = &mt('Could not determine home server for course.');
                   11307:         } else {
                   11308:             my @ids=&Apache::lonnet::current_machine_ids();
                   11309:             my $currdir = "$dir_root/$destination";
                   11310:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11311:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11312:                        "$dir_root/$destination";
                   11313:             } else {
                   11314:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11315:                        "$dir_root/$docudom/$docuname/$destination";
                   11316:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11317:                     $error = &mt('Archive file not found.');
                   11318:                 }
                   11319:             }
1.1065    raeburn  11320:             my (@to_overwrite,@to_skip);
                   11321:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11322:                 my $total = $env{'form.archive_overwrite_total'};
                   11323:                 for (my $i=0; $i<$total; $i++) {
                   11324:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11325:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11326:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11327:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11328:                     }
                   11329:                 }
                   11330:             }
                   11331:             my $numskip = scalar(@to_skip);
                   11332:             if (($numskip > 0) && 
                   11333:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11334:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11335:             } elsif ($dir eq '') {
1.1055    raeburn  11336:                 $error = &mt('Directory containing archive file unavailable.');
                   11337:             } elsif (!$error) {
1.1065    raeburn  11338:                 my ($decompressed,$display);
                   11339:                 if ($numskip > 0) {
                   11340:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11341:                     mkdir("$dir/$tempdir",0755);
                   11342:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11343:                     ($decompressed,$display) = 
                   11344:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11345:                     foreach my $item (@to_skip) {
                   11346:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11347:                             if (-f "$dir/$tempdir/$item") { 
                   11348:                                 unlink("$dir/$tempdir/$item");
                   11349:                             } elsif (-d "$dir/$tempdir/$item") {
                   11350:                                 system("rm -rf $dir/$tempdir/$item");
                   11351:                             }
                   11352:                         }
                   11353:                     }
                   11354:                     system("mv $dir/$tempdir/* $dir");
                   11355:                     rmdir("$dir/$tempdir");   
                   11356:                 } else {
                   11357:                     ($decompressed,$display) = 
                   11358:                         &decompress_uploaded_file($file,$dir);
                   11359:                 }
1.1055    raeburn  11360:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11361:                     $output = '<p class="LC_info">'.
                   11362:                               &mt('Files extracted successfully from archive.').
                   11363:                               '</p>'."\n";
1.1055    raeburn  11364:                     my ($warning,$result,@contents);
                   11365:                     my ($newdirlistref,$newlisterror) =
                   11366:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11367:                                                  $docuname,1);
                   11368:                     my (%is_dir,%changes,@newitems);
                   11369:                     my $dirptr = 16384;
1.1065    raeburn  11370:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11371:                         foreach my $dir_line (@{$newdirlistref}) {
                   11372:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11373:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11374:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11375:                                 push(@newitems,$item);
                   11376:                                 if ($dirptr&$testdir) {
                   11377:                                     $is_dir{$item} = 1;
                   11378:                                 }
                   11379:                                 $changes{$item} = 1;
                   11380:                             }
                   11381:                         }
                   11382:                     }
                   11383:                     if (keys(%changes) > 0) {
                   11384:                         foreach my $item (sort(@newitems)) {
                   11385:                             if ($changes{$item}) {
                   11386:                                 push(@contents,$item);
                   11387:                             }
                   11388:                         }
                   11389:                     }
                   11390:                     if (@contents > 0) {
1.1067    raeburn  11391:                         my $wantform;
                   11392:                         unless ($env{'form.autoextract_camtasia'}) {
                   11393:                             $wantform = 1;
                   11394:                         }
1.1056    raeburn  11395:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11396:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11397:                                                                 $currdir,\%is_dir,
                   11398:                                                                 \%children,\%parent,
1.1056    raeburn  11399:                                                                 \@contents,\%dirorder,
                   11400:                                                                 \%titles,$wantform);
1.1055    raeburn  11401:                         if ($datatable ne '') {
                   11402:                             $output .= &archive_options_form('decompressed',$datatable,
                   11403:                                                              $count,$hiddenelem);
1.1065    raeburn  11404:                             my $startcount = 6;
1.1055    raeburn  11405:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11406:                                                            \%titles,\%children);
1.1055    raeburn  11407:                         }
1.1067    raeburn  11408:                         if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59  raeburn  11409:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  11410:                             my %displayed;
                   11411:                             my $total = 1;
                   11412:                             $env{'form.archive_directory'} = [];
                   11413:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11414:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11415:                                 $path =~ s{/$}{};
                   11416:                                 my $item;
                   11417:                                 if ($path ne '') {
                   11418:                                     $item = "$path/$titles{$i}";
                   11419:                                 } else {
                   11420:                                     $item = $titles{$i};
                   11421:                                 }
                   11422:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11423:                                 if ($item eq $contents[0]) {
                   11424:                                     push(@{$env{'form.archive_directory'}},$i);
                   11425:                                     $env{'form.archive_'.$i} = 'display';
                   11426:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11427:                                     $displayed{'folder'} = $i;
1.1075.2.59  raeburn  11428:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   11429:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067    raeburn  11430:                                     $env{'form.archive_'.$i} = 'display';
                   11431:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11432:                                     $displayed{'web'} = $i;
                   11433:                                 } else {
1.1075.2.59  raeburn  11434:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   11435:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   11436:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  11437:                                         push(@{$env{'form.archive_directory'}},$i);
                   11438:                                     }
                   11439:                                     $env{'form.archive_'.$i} = 'dependency';
                   11440:                                 }
                   11441:                                 $total ++;
                   11442:                             }
                   11443:                             for (my $i=1; $i<$total; $i++) {
                   11444:                                 next if ($i == $displayed{'web'});
                   11445:                                 next if ($i == $displayed{'folder'});
                   11446:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11447:                             }
                   11448:                             $env{'form.phase'} = 'decompress_cleanup';
                   11449:                             $env{'form.archivedelete'} = 1;
                   11450:                             $env{'form.archive_count'} = $total-1;
                   11451:                             $output .=
                   11452:                                 &process_extracted_files('coursedocs',$docudom,
                   11453:                                                          $docuname,$destination,
                   11454:                                                          $dir_root,$hiddenelem);
                   11455:                         }
1.1055    raeburn  11456:                     } else {
                   11457:                         $warning = &mt('No new items extracted from archive file.');
                   11458:                     }
                   11459:                 } else {
                   11460:                     $output = $display;
                   11461:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11462:                 }
                   11463:             }
                   11464:         }
                   11465:     }
                   11466:     if ($error) {
                   11467:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11468:                    $error.'</p>'."\n";
                   11469:     }
                   11470:     if ($warning) {
                   11471:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11472:     }
                   11473:     return $output;
                   11474: }
                   11475: 
                   11476: sub get_extracted {
1.1056    raeburn  11477:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11478:         $titles,$wantform) = @_;
1.1055    raeburn  11479:     my $count = 0;
                   11480:     my $depth = 0;
                   11481:     my $datatable;
1.1056    raeburn  11482:     my @hierarchy;
1.1055    raeburn  11483:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11484:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11485:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11486:     foreach my $item (@{$contents}) {
                   11487:         $count ++;
1.1056    raeburn  11488:         @{$dirorder->{$count}} = @hierarchy;
                   11489:         $titles->{$count} = $item;
1.1055    raeburn  11490:         &archive_hierarchy($depth,$count,$parent,$children);
                   11491:         if ($wantform) {
                   11492:             $datatable .= &archive_row($is_dir->{$item},$item,
                   11493:                                        $currdir,$depth,$count);
                   11494:         }
                   11495:         if ($is_dir->{$item}) {
                   11496:             $depth ++;
1.1056    raeburn  11497:             push(@hierarchy,$count);
                   11498:             $parent->{$depth} = $count;
1.1055    raeburn  11499:             $datatable .=
                   11500:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  11501:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   11502:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  11503:             $depth --;
1.1056    raeburn  11504:             pop(@hierarchy);
1.1055    raeburn  11505:         }
                   11506:     }
                   11507:     return ($count,$datatable);
                   11508: }
                   11509: 
                   11510: sub recurse_extracted_archive {
1.1056    raeburn  11511:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   11512:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  11513:     my $result='';
1.1056    raeburn  11514:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   11515:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   11516:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  11517:         return $result;
                   11518:     }
                   11519:     my $dirptr = 16384;
                   11520:     my ($newdirlistref,$newlisterror) =
                   11521:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   11522:     if (ref($newdirlistref) eq 'ARRAY') {
                   11523:         foreach my $dir_line (@{$newdirlistref}) {
                   11524:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   11525:             unless ($item =~ /^\.+$/) {
                   11526:                 $$count ++;
1.1056    raeburn  11527:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   11528:                 $titles->{$$count} = $item;
1.1055    raeburn  11529:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  11530: 
1.1055    raeburn  11531:                 my $is_dir;
                   11532:                 if ($dirptr&$testdir) {
                   11533:                     $is_dir = 1;
                   11534:                 }
                   11535:                 if ($wantform) {
                   11536:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11537:                 }
                   11538:                 if ($is_dir) {
                   11539:                     $$depth ++;
1.1056    raeburn  11540:                     push(@{$hierarchy},$$count);
                   11541:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11542:                     $result .=
                   11543:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11544:                                                    $docuname,$depth,$count,
1.1056    raeburn  11545:                                                    $hierarchy,$dirorder,$children,
                   11546:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11547:                     $$depth --;
1.1056    raeburn  11548:                     pop(@{$hierarchy});
1.1055    raeburn  11549:                 }
                   11550:             }
                   11551:         }
                   11552:     }
                   11553:     return $result;
                   11554: }
                   11555: 
                   11556: sub archive_hierarchy {
                   11557:     my ($depth,$count,$parent,$children) =@_;
                   11558:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11559:         if (exists($parent->{$depth})) {
                   11560:              $children->{$parent->{$depth}} .= $count.':';
                   11561:         }
                   11562:     }
                   11563:     return;
                   11564: }
                   11565: 
                   11566: sub archive_row {
                   11567:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11568:     my ($name) = ($item =~ m{([^/]+)$});
                   11569:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11570:                                        'display'    => 'Add as file',
1.1055    raeburn  11571:                                        'dependency' => 'Include as dependency',
                   11572:                                        'discard'    => 'Discard',
                   11573:                                       );
                   11574:     if ($is_dir) {
1.1059    raeburn  11575:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11576:     }
1.1056    raeburn  11577:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11578:     my $offset = 0;
1.1055    raeburn  11579:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11580:         $offset ++;
1.1065    raeburn  11581:         if ($action ne 'display') {
                   11582:             $offset ++;
                   11583:         }  
1.1055    raeburn  11584:         $output .= '<td><span class="LC_nobreak">'.
                   11585:                    '<label><input type="radio" name="archive_'.$count.
                   11586:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11587:         my $text = $choices{$action};
                   11588:         if ($is_dir) {
                   11589:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11590:             if ($action eq 'display') {
1.1059    raeburn  11591:                 $text = &mt('Add as folder');
1.1055    raeburn  11592:             }
1.1056    raeburn  11593:         } else {
                   11594:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11595: 
                   11596:         }
                   11597:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11598:         if ($action eq 'dependency') {
                   11599:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11600:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11601:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11602:                        '<option value=""></option>'."\n".
                   11603:                        '</select>'."\n".
                   11604:                        '</div>';
1.1059    raeburn  11605:         } elsif ($action eq 'display') {
                   11606:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11607:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11608:                        '</div>';
1.1055    raeburn  11609:         }
1.1056    raeburn  11610:         $output .= '</td>';
1.1055    raeburn  11611:     }
                   11612:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11613:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11614:     for (my $i=0; $i<$depth; $i++) {
                   11615:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11616:     }
                   11617:     if ($is_dir) {
                   11618:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11619:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11620:     } else {
                   11621:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11622:     }
                   11623:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11624:                &end_data_table_row();
                   11625:     return $output;
                   11626: }
                   11627: 
                   11628: sub archive_options_form {
1.1065    raeburn  11629:     my ($form,$display,$count,$hiddenelem) = @_;
                   11630:     my %lt = &Apache::lonlocal::texthash(
                   11631:                perm => 'Permanently remove archive file?',
                   11632:                hows => 'How should each extracted item be incorporated in the course?',
                   11633:                cont => 'Content actions for all',
                   11634:                addf => 'Add as folder/file',
                   11635:                incd => 'Include as dependency for a displayed file',
                   11636:                disc => 'Discard',
                   11637:                no   => 'No',
                   11638:                yes  => 'Yes',
                   11639:                save => 'Save',
                   11640:     );
                   11641:     my $output = <<"END";
                   11642: <form name="$form" method="post" action="">
                   11643: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11644: <label>
                   11645:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11646: </label>
                   11647: &nbsp;
                   11648: <label>
                   11649:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11650: </span>
                   11651: </p>
                   11652: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11653: <br />$lt{'hows'}
                   11654: <div class="LC_columnSection">
                   11655:   <fieldset>
                   11656:     <legend>$lt{'cont'}</legend>
                   11657:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11658:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11659:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11660:   </fieldset>
                   11661: </div>
                   11662: END
                   11663:     return $output.
1.1055    raeburn  11664:            &start_data_table()."\n".
1.1065    raeburn  11665:            $display."\n".
1.1055    raeburn  11666:            &end_data_table()."\n".
                   11667:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11668:            $hiddenelem.
1.1065    raeburn  11669:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11670:            '</form>';
                   11671: }
                   11672: 
                   11673: sub archive_javascript {
1.1056    raeburn  11674:     my ($startcount,$numitems,$titles,$children) = @_;
                   11675:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11676:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11677:     my $scripttag = <<START;
                   11678: <script type="text/javascript">
                   11679: // <![CDATA[
                   11680: 
                   11681: function checkAll(form,prefix) {
                   11682:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11683:     for (var i=0; i < form.elements.length; i++) {
                   11684:         var id = form.elements[i].id;
                   11685:         if ((id != '') && (id != undefined)) {
                   11686:             if (idstr.test(id)) {
                   11687:                 if (form.elements[i].type == 'radio') {
                   11688:                     form.elements[i].checked = true;
1.1056    raeburn  11689:                     var nostart = i-$startcount;
1.1059    raeburn  11690:                     var offset = nostart%7;
                   11691:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11692:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11693:                 }
                   11694:             }
                   11695:         }
                   11696:     }
                   11697: }
                   11698: 
                   11699: function propagateCheck(form,count) {
                   11700:     if (count > 0) {
1.1059    raeburn  11701:         var startelement = $startcount + ((count-1) * 7);
                   11702:         for (var j=1; j<6; j++) {
                   11703:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11704:                 var item = startelement + j; 
                   11705:                 if (form.elements[item].type == 'radio') {
                   11706:                     if (form.elements[item].checked) {
                   11707:                         containerCheck(form,count,j);
                   11708:                         break;
                   11709:                     }
1.1055    raeburn  11710:                 }
                   11711:             }
                   11712:         }
                   11713:     }
                   11714: }
                   11715: 
                   11716: numitems = $numitems
1.1056    raeburn  11717: var titles = new Array(numitems);
                   11718: var parents = new Array(numitems);
1.1055    raeburn  11719: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11720:     parents[i] = new Array;
1.1055    raeburn  11721: }
1.1059    raeburn  11722: var maintitle = '$maintitle';
1.1055    raeburn  11723: 
                   11724: START
                   11725: 
1.1056    raeburn  11726:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11727:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11728:         for (my $i=0; $i<@contents; $i ++) {
                   11729:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11730:         }
                   11731:     }
                   11732: 
1.1056    raeburn  11733:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11734:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11735:     }
                   11736: 
1.1055    raeburn  11737:     $scripttag .= <<END;
                   11738: 
                   11739: function containerCheck(form,count,offset) {
                   11740:     if (count > 0) {
1.1056    raeburn  11741:         dependencyCheck(form,count,offset);
1.1059    raeburn  11742:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11743:         form.elements[item].checked = true;
                   11744:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11745:             if (parents[count].length > 0) {
                   11746:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11747:                     containerCheck(form,parents[count][j],offset);
                   11748:                 }
                   11749:             }
                   11750:         }
                   11751:     }
                   11752: }
                   11753: 
                   11754: function dependencyCheck(form,count,offset) {
                   11755:     if (count > 0) {
1.1059    raeburn  11756:         var chosen = (offset+$startcount)+7*(count-1);
                   11757:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11758:         var currtype = form.elements[depitem].type;
                   11759:         if (form.elements[chosen].value == 'dependency') {
                   11760:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11761:             form.elements[depitem].options.length = 0;
                   11762:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  11763:             for (var i=1; i<=numitems; i++) {
                   11764:                 if (i == count) {
                   11765:                     continue;
                   11766:                 }
1.1059    raeburn  11767:                 var startelement = $startcount + (i-1) * 7;
                   11768:                 for (var j=1; j<6; j++) {
                   11769:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11770:                         var item = startelement + j;
                   11771:                         if (form.elements[item].type == 'radio') {
                   11772:                             if (form.elements[item].checked) {
                   11773:                                 if (form.elements[item].value == 'display') {
                   11774:                                     var n = form.elements[depitem].options.length;
                   11775:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11776:                                 }
                   11777:                             }
                   11778:                         }
                   11779:                     }
                   11780:                 }
                   11781:             }
                   11782:         } else {
                   11783:             document.getElementById('arc_depon_'+count).style.display='none';
                   11784:             form.elements[depitem].options.length = 0;
                   11785:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11786:         }
1.1059    raeburn  11787:         titleCheck(form,count,offset);
1.1056    raeburn  11788:     }
                   11789: }
                   11790: 
                   11791: function propagateSelect(form,count,offset) {
                   11792:     if (count > 0) {
1.1065    raeburn  11793:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11794:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11795:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11796:             if (parents[count].length > 0) {
                   11797:                 for (var j=0; j<parents[count].length; j++) {
                   11798:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11799:                 }
                   11800:             }
                   11801:         }
                   11802:     }
                   11803: }
1.1056    raeburn  11804: 
                   11805: function containerSelect(form,count,offset,picked) {
                   11806:     if (count > 0) {
1.1065    raeburn  11807:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11808:         if (form.elements[item].type == 'radio') {
                   11809:             if (form.elements[item].value == 'dependency') {
                   11810:                 if (form.elements[item+1].type == 'select-one') {
                   11811:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11812:                         if (form.elements[item+1].options[i].value == picked) {
                   11813:                             form.elements[item+1].selectedIndex = i;
                   11814:                             break;
                   11815:                         }
                   11816:                     }
                   11817:                 }
                   11818:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11819:                     if (parents[count].length > 0) {
                   11820:                         for (var j=0; j<parents[count].length; j++) {
                   11821:                             containerSelect(form,parents[count][j],offset,picked);
                   11822:                         }
                   11823:                     }
                   11824:                 }
                   11825:             }
                   11826:         }
                   11827:     }
                   11828: }
                   11829: 
1.1059    raeburn  11830: function titleCheck(form,count,offset) {
                   11831:     if (count > 0) {
                   11832:         var chosen = (offset+$startcount)+7*(count-1);
                   11833:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11834:         var currtype = form.elements[depitem].type;
                   11835:         if (form.elements[chosen].value == 'display') {
                   11836:             document.getElementById('arc_title_'+count).style.display='block';
                   11837:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11838:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11839:             }
                   11840:         } else {
                   11841:             document.getElementById('arc_title_'+count).style.display='none';
                   11842:             if (currtype == 'text') { 
                   11843:                 document.getElementById('archive_title_'+count).value='';
                   11844:             }
                   11845:         }
                   11846:     }
                   11847:     return;
                   11848: }
                   11849: 
1.1055    raeburn  11850: // ]]>
                   11851: </script>
                   11852: END
                   11853:     return $scripttag;
                   11854: }
                   11855: 
                   11856: sub process_extracted_files {
1.1067    raeburn  11857:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11858:     my $numitems = $env{'form.archive_count'};
                   11859:     return unless ($numitems);
                   11860:     my @ids=&Apache::lonnet::current_machine_ids();
                   11861:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11862:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11863:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11864:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11865:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11866:         $pathtocheck = "$dir_root/$destination";
                   11867:         $dir = $dir_root;
                   11868:         $ishome = 1;
                   11869:     } else {
                   11870:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11871:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11872:         $dir = "$dir_root/$docudom/$docuname";    
                   11873:     }
                   11874:     my $currdir = "$dir_root/$destination";
                   11875:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11876:     if ($env{'form.folderpath'}) {
                   11877:         my @items = split('&',$env{'form.folderpath'});
                   11878:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  11879:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11880:             $containers{'0'}='page';
                   11881:         } else {
                   11882:             $containers{'0'}='sequence';
                   11883:         }
1.1055    raeburn  11884:     }
                   11885:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11886:     if ($numitems) {
                   11887:         for (my $i=1; $i<=$numitems; $i++) {
                   11888:             my $path = $env{'form.archive_content_'.$i};
                   11889:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11890:                 my $item = $1;
                   11891:                 $toplevelitems{$item} = $i;
                   11892:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11893:                     $is_dir{$item} = 1;
                   11894:                 }
                   11895:             }
                   11896:         }
                   11897:     }
1.1067    raeburn  11898:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11899:     if (keys(%toplevelitems) > 0) {
                   11900:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11901:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11902:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11903:     }
1.1066    raeburn  11904:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11905:     if ($numitems) {
                   11906:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  11907:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11908:             my $path = $env{'form.archive_content_'.$i};
                   11909:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11910:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11911:                     if ($prefix ne '' && $path ne '') {
                   11912:                         if (-e $prefix.$path) {
1.1066    raeburn  11913:                             if ((@archdirs > 0) && 
                   11914:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11915:                                 $todeletedir{$prefix.$path} = 1;
                   11916:                             } else {
                   11917:                                 $todelete{$prefix.$path} = 1;
                   11918:                             }
1.1055    raeburn  11919:                         }
                   11920:                     }
                   11921:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11922:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11923:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11924:                     $docstitle = $env{'form.archive_title_'.$i};
                   11925:                     if ($docstitle eq '') {
                   11926:                         $docstitle = $title;
                   11927:                     }
1.1055    raeburn  11928:                     $outer = 0;
1.1056    raeburn  11929:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11930:                         if (@{$dirorder{$i}} > 0) {
                   11931:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11932:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11933:                                     $outer = $item;
                   11934:                                     last;
                   11935:                                 }
                   11936:                             }
                   11937:                         }
                   11938:                     }
                   11939:                     my ($errtext,$fatal) = 
                   11940:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11941:                                                '/'.$folders{$outer}.'.'.
                   11942:                                                $containers{$outer});
                   11943:                     next if ($fatal);
                   11944:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11945:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11946:                             $mapinner{$i} = time;
1.1055    raeburn  11947:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11948:                             $containers{$i} = 'sequence';
                   11949:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11950:                                       $folders{$i}.'.'.$containers{$i};
                   11951:                             my $newidx = &LONCAPA::map::getresidx();
                   11952:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11953:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11954:                             push(@LONCAPA::map::order,$newidx);
                   11955:                             my ($outtext,$errtext) =
                   11956:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11957:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11958:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11959:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11960:                             unless ($errtext) {
                   11961:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11962:                             }
1.1055    raeburn  11963:                         }
                   11964:                     } else {
                   11965:                         if ($context eq 'coursedocs') {
                   11966:                             my $newidx=&LONCAPA::map::getresidx();
                   11967:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11968:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11969:                                       $title;
                   11970:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11971:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11972:                             }
                   11973:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11974:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11975:                             }
                   11976:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11977:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11978:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11979:                                 unless ($ishome) {
                   11980:                                     my $fetch = "$newdest{$i}/$title";
                   11981:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11982:                                     $prompttofetch{$fetch} = 1;
                   11983:                                 }
1.1055    raeburn  11984:                             }
                   11985:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11986:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11987:                             push(@LONCAPA::map::order, $newidx);
                   11988:                             my ($outtext,$errtext)=
                   11989:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11990:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11991:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11992:                             unless ($errtext) {
                   11993:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11994:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11995:                                 }
                   11996:                             }
1.1055    raeburn  11997:                         }
                   11998:                     }
1.1075.2.11  raeburn  11999:                 }
                   12000:             } else {
                   12001:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                   12002:             }
                   12003:         }
                   12004:         for (my $i=1; $i<=$numitems; $i++) {
                   12005:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   12006:             my $path = $env{'form.archive_content_'.$i};
                   12007:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12008:                 my ($title) = ($path =~ m{/([^/]+)$});
                   12009:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   12010:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   12011:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12012:                         my ($itemidx,$fullpath,$relpath);
                   12013:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   12014:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  12015:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  12016:                                 if ($dirorder{$i}->[$j] eq $container) {
                   12017:                                     $itemidx = $j;
1.1056    raeburn  12018:                                 }
                   12019:                             }
1.1075.2.11  raeburn  12020:                         }
                   12021:                         if ($itemidx eq '') {
                   12022:                             $itemidx =  0;
                   12023:                         }
                   12024:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12025:                             if ($mapinner{$referrer{$i}}) {
                   12026:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12027:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12028:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12029:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12030:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12031:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12032:                                             if (!-e $fullpath) {
                   12033:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12034:                                             }
                   12035:                                         }
1.1075.2.11  raeburn  12036:                                     } else {
                   12037:                                         last;
1.1056    raeburn  12038:                                     }
1.1075.2.11  raeburn  12039:                                 }
                   12040:                             }
                   12041:                         } elsif ($newdest{$referrer{$i}}) {
                   12042:                             $fullpath = $newdest{$referrer{$i}};
                   12043:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12044:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12045:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12046:                                     last;
                   12047:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12048:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12049:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12050:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12051:                                         if (!-e $fullpath) {
                   12052:                                             mkdir($fullpath,0755);
1.1056    raeburn  12053:                                         }
                   12054:                                     }
1.1075.2.11  raeburn  12055:                                 } else {
                   12056:                                     last;
1.1056    raeburn  12057:                                 }
1.1075.2.11  raeburn  12058:                             }
                   12059:                         }
                   12060:                         if ($fullpath ne '') {
                   12061:                             if (-e "$prefix$path") {
                   12062:                                 system("mv $prefix$path $fullpath/$title");
                   12063:                             }
                   12064:                             if (-e "$fullpath/$title") {
                   12065:                                 my $showpath;
                   12066:                                 if ($relpath ne '') {
                   12067:                                     $showpath = "$relpath/$title";
                   12068:                                 } else {
                   12069:                                     $showpath = "/$title";
1.1056    raeburn  12070:                                 }
1.1075.2.11  raeburn  12071:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   12072:                             }
                   12073:                             unless ($ishome) {
                   12074:                                 my $fetch = "$fullpath/$title";
                   12075:                                 $fetch =~ s/^\Q$prefix$dir\E//;
                   12076:                                 $prompttofetch{$fetch} = 1;
1.1055    raeburn  12077:                             }
                   12078:                         }
                   12079:                     }
1.1075.2.11  raeburn  12080:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12081:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   12082:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  12083:                 }
                   12084:             } else {
1.1075.2.11  raeburn  12085:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055    raeburn  12086:             }
                   12087:         }
                   12088:         if (keys(%todelete)) {
                   12089:             foreach my $key (keys(%todelete)) {
                   12090:                 unlink($key);
1.1066    raeburn  12091:             }
                   12092:         }
                   12093:         if (keys(%todeletedir)) {
                   12094:             foreach my $key (keys(%todeletedir)) {
                   12095:                 rmdir($key);
                   12096:             }
                   12097:         }
                   12098:         foreach my $dir (sort(keys(%is_dir))) {
                   12099:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12100:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12101:             }
                   12102:         }
1.1067    raeburn  12103:         if ($result ne '') {
                   12104:             $output .= '<ul>'."\n".
                   12105:                        $result."\n".
                   12106:                        '</ul>';
                   12107:         }
                   12108:         unless ($ishome) {
                   12109:             my $replicationfail;
                   12110:             foreach my $item (keys(%prompttofetch)) {
                   12111:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12112:                 unless ($fetchresult eq 'ok') {
                   12113:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12114:                 }
                   12115:             }
                   12116:             if ($replicationfail) {
                   12117:                 $output .= '<p class="LC_error">'.
                   12118:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12119:                            $replicationfail.
                   12120:                            '</ul></p>';
                   12121:             }
                   12122:         }
1.1055    raeburn  12123:     } else {
                   12124:         $warning = &mt('No items found in archive.');
                   12125:     }
                   12126:     if ($error) {
                   12127:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12128:                    $error.'</p>'."\n";
                   12129:     }
                   12130:     if ($warning) {
                   12131:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12132:     }
                   12133:     return $output;
                   12134: }
                   12135: 
1.1066    raeburn  12136: sub cleanup_empty_dirs {
                   12137:     my ($path) = @_;
                   12138:     if (($path ne '') && (-d $path)) {
                   12139:         if (opendir(my $dirh,$path)) {
                   12140:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12141:             my $numitems = 0;
                   12142:             foreach my $item (@dircontents) {
                   12143:                 if (-d "$path/$item") {
1.1075.2.28  raeburn  12144:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12145:                     if (-e "$path/$item") {
                   12146:                         $numitems ++;
                   12147:                     }
                   12148:                 } else {
                   12149:                     $numitems ++;
                   12150:                 }
                   12151:             }
                   12152:             if ($numitems == 0) {
                   12153:                 rmdir($path);
                   12154:             }
                   12155:             closedir($dirh);
                   12156:         }
                   12157:     }
                   12158:     return;
                   12159: }
                   12160: 
1.41      ng       12161: =pod
1.45      matthew  12162: 
1.1075.2.56  raeburn  12163: =item * &get_folder_hierarchy()
1.1068    raeburn  12164: 
                   12165: Provides hierarchy of names of folders/sub-folders containing the current
                   12166: item,
                   12167: 
                   12168: Inputs: 3
                   12169:      - $navmap - navmaps object
                   12170: 
                   12171:      - $map - url for map (either the trigger itself, or map containing
                   12172:                            the resource, which is the trigger).
                   12173: 
                   12174:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12175: 
                   12176: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12177: 
                   12178: =cut
                   12179: 
                   12180: sub get_folder_hierarchy {
                   12181:     my ($navmap,$map,$showitem) = @_;
                   12182:     my @pathitems;
                   12183:     if (ref($navmap)) {
                   12184:         my $mapres = $navmap->getResourceByUrl($map);
                   12185:         if (ref($mapres)) {
                   12186:             my $pcslist = $mapres->map_hierarchy();
                   12187:             if ($pcslist ne '') {
                   12188:                 my @pcs = split(/,/,$pcslist);
                   12189:                 foreach my $pc (@pcs) {
                   12190:                     if ($pc == 1) {
1.1075.2.38  raeburn  12191:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12192:                     } else {
                   12193:                         my $res = $navmap->getByMapPc($pc);
                   12194:                         if (ref($res)) {
                   12195:                             my $title = $res->compTitle();
                   12196:                             $title =~ s/\W+/_/g;
                   12197:                             if ($title ne '') {
                   12198:                                 push(@pathitems,$title);
                   12199:                             }
                   12200:                         }
                   12201:                     }
                   12202:                 }
                   12203:             }
1.1071    raeburn  12204:             if ($showitem) {
                   12205:                 if ($mapres->{ID} eq '0.0') {
1.1075.2.38  raeburn  12206:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12207:                 } else {
                   12208:                     my $maptitle = $mapres->compTitle();
                   12209:                     $maptitle =~ s/\W+/_/g;
                   12210:                     if ($maptitle ne '') {
                   12211:                         push(@pathitems,$maptitle);
                   12212:                     }
1.1068    raeburn  12213:                 }
                   12214:             }
                   12215:         }
                   12216:     }
                   12217:     return @pathitems;
                   12218: }
                   12219: 
                   12220: =pod
                   12221: 
1.1015    raeburn  12222: =item * &get_turnedin_filepath()
                   12223: 
                   12224: Determines path in a user's portfolio file for storage of files uploaded
                   12225: to a specific essayresponse or dropbox item.
                   12226: 
                   12227: Inputs: 3 required + 1 optional.
                   12228: $symb is symb for resource, $uname and $udom are for current user (required).
                   12229: $caller is optional (can be "submission", if routine is called when storing
                   12230: an upoaded file when "Submit Answer" button was pressed).
                   12231: 
                   12232: Returns array containing $path and $multiresp. 
                   12233: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12234: than one file upload item.  Callers of routine should append partid as a 
                   12235: subdirectory to $path in cases where $multiresp is 1.
                   12236: 
                   12237: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12238: 
                   12239: =cut
                   12240: 
                   12241: sub get_turnedin_filepath {
                   12242:     my ($symb,$uname,$udom,$caller) = @_;
                   12243:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12244:     my $turnindir;
                   12245:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12246:     $turnindir = $userhash{'turnindir'};
                   12247:     my ($path,$multiresp);
                   12248:     if ($turnindir eq '') {
                   12249:         if ($caller eq 'submission') {
                   12250:             $turnindir = &mt('turned in');
                   12251:             $turnindir =~ s/\W+/_/g;
                   12252:             my %newhash = (
                   12253:                             'turnindir' => $turnindir,
                   12254:                           );
                   12255:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12256:         }
                   12257:     }
                   12258:     if ($turnindir ne '') {
                   12259:         $path = '/'.$turnindir.'/';
                   12260:         my ($multipart,$turnin,@pathitems);
                   12261:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12262:         if (defined($navmap)) {
                   12263:             my $mapres = $navmap->getResourceByUrl($map);
                   12264:             if (ref($mapres)) {
                   12265:                 my $pcslist = $mapres->map_hierarchy();
                   12266:                 if ($pcslist ne '') {
                   12267:                     foreach my $pc (split(/,/,$pcslist)) {
                   12268:                         my $res = $navmap->getByMapPc($pc);
                   12269:                         if (ref($res)) {
                   12270:                             my $title = $res->compTitle();
                   12271:                             $title =~ s/\W+/_/g;
                   12272:                             if ($title ne '') {
1.1075.2.48  raeburn  12273:                                 if (($pc > 1) && (length($title) > 12)) {
                   12274:                                     $title = substr($title,0,12);
                   12275:                                 }
1.1015    raeburn  12276:                                 push(@pathitems,$title);
                   12277:                             }
                   12278:                         }
                   12279:                     }
                   12280:                 }
                   12281:                 my $maptitle = $mapres->compTitle();
                   12282:                 $maptitle =~ s/\W+/_/g;
                   12283:                 if ($maptitle ne '') {
1.1075.2.48  raeburn  12284:                     if (length($maptitle) > 12) {
                   12285:                         $maptitle = substr($maptitle,0,12);
                   12286:                     }
1.1015    raeburn  12287:                     push(@pathitems,$maptitle);
                   12288:                 }
                   12289:                 unless ($env{'request.state'} eq 'construct') {
                   12290:                     my $res = $navmap->getBySymb($symb);
                   12291:                     if (ref($res)) {
                   12292:                         my $partlist = $res->parts();
                   12293:                         my $totaluploads = 0;
                   12294:                         if (ref($partlist) eq 'ARRAY') {
                   12295:                             foreach my $part (@{$partlist}) {
                   12296:                                 my @types = $res->responseType($part);
                   12297:                                 my @ids = $res->responseIds($part);
                   12298:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12299:                                     if ($types[$i] eq 'essay') {
                   12300:                                         my $partid = $part.'_'.$ids[$i];
                   12301:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12302:                                             $totaluploads ++;
                   12303:                                         }
                   12304:                                     }
                   12305:                                 }
                   12306:                             }
                   12307:                             if ($totaluploads > 1) {
                   12308:                                 $multiresp = 1;
                   12309:                             }
                   12310:                         }
                   12311:                     }
                   12312:                 }
                   12313:             } else {
                   12314:                 return;
                   12315:             }
                   12316:         } else {
                   12317:             return;
                   12318:         }
                   12319:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12320:         $restitle =~ s/\W+/_/g;
                   12321:         if ($restitle eq '') {
                   12322:             $restitle = ($resurl =~ m{/[^/]+$});
                   12323:             if ($restitle eq '') {
                   12324:                 $restitle = time;
                   12325:             }
                   12326:         }
1.1075.2.48  raeburn  12327:         if (length($restitle) > 12) {
                   12328:             $restitle = substr($restitle,0,12);
                   12329:         }
1.1015    raeburn  12330:         push(@pathitems,$restitle);
                   12331:         $path .= join('/',@pathitems);
                   12332:     }
                   12333:     return ($path,$multiresp);
                   12334: }
                   12335: 
                   12336: =pod
                   12337: 
1.464     albertel 12338: =back
1.41      ng       12339: 
1.112     bowersj2 12340: =head1 CSV Upload/Handling functions
1.38      albertel 12341: 
1.41      ng       12342: =over 4
                   12343: 
1.648     raeburn  12344: =item * &upfile_store($r)
1.41      ng       12345: 
                   12346: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12347: needs $env{'form.upfile'}
1.41      ng       12348: returns $datatoken to be put into hidden field
                   12349: 
                   12350: =cut
1.31      albertel 12351: 
                   12352: sub upfile_store {
                   12353:     my $r=shift;
1.258     albertel 12354:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12355:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12356:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12357:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12358: 
1.258     albertel 12359:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12360: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12361:     {
1.158     raeburn  12362:         my $datafile = $r->dir_config('lonDaemons').
                   12363:                            '/tmp/'.$datatoken.'.tmp';
                   12364:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12365:             print $fh $env{'form.upfile'};
1.158     raeburn  12366:             close($fh);
                   12367:         }
1.31      albertel 12368:     }
                   12369:     return $datatoken;
                   12370: }
                   12371: 
1.56      matthew  12372: =pod
                   12373: 
1.648     raeburn  12374: =item * &load_tmp_file($r)
1.41      ng       12375: 
                   12376: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12377: needs $env{'form.datatoken'},
                   12378: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12379: 
                   12380: =cut
1.31      albertel 12381: 
                   12382: sub load_tmp_file {
                   12383:     my $r=shift;
                   12384:     my @studentdata=();
                   12385:     {
1.158     raeburn  12386:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12387:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12388:         if ( open(my $fh,"<$studentfile") ) {
                   12389:             @studentdata=<$fh>;
                   12390:             close($fh);
                   12391:         }
1.31      albertel 12392:     }
1.258     albertel 12393:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12394: }
                   12395: 
1.56      matthew  12396: =pod
                   12397: 
1.648     raeburn  12398: =item * &upfile_record_sep()
1.41      ng       12399: 
                   12400: Separate uploaded file into records
                   12401: returns array of records,
1.258     albertel 12402: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12403: 
                   12404: =cut
1.31      albertel 12405: 
                   12406: sub upfile_record_sep {
1.258     albertel 12407:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12408:     } else {
1.248     albertel 12409: 	my @records;
1.258     albertel 12410: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12411: 	    if ($line=~/^\s*$/) { next; }
                   12412: 	    push(@records,$line);
                   12413: 	}
                   12414: 	return @records;
1.31      albertel 12415:     }
                   12416: }
                   12417: 
1.56      matthew  12418: =pod
                   12419: 
1.648     raeburn  12420: =item * &record_sep($record)
1.41      ng       12421: 
1.258     albertel 12422: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12423: 
                   12424: =cut
                   12425: 
1.263     www      12426: sub takeleft {
                   12427:     my $index=shift;
                   12428:     return substr('0000'.$index,-4,4);
                   12429: }
                   12430: 
1.31      albertel 12431: sub record_sep {
                   12432:     my $record=shift;
                   12433:     my %components=();
1.258     albertel 12434:     if ($env{'form.upfiletype'} eq 'xml') {
                   12435:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12436:         my $i=0;
1.356     albertel 12437:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12438:             $field=~s/^(\"|\')//;
                   12439:             $field=~s/(\"|\')$//;
1.263     www      12440:             $components{&takeleft($i)}=$field;
1.31      albertel 12441:             $i++;
                   12442:         }
1.258     albertel 12443:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12444:         my $i=0;
1.356     albertel 12445:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12446:             $field=~s/^(\"|\')//;
                   12447:             $field=~s/(\"|\')$//;
1.263     www      12448:             $components{&takeleft($i)}=$field;
1.31      albertel 12449:             $i++;
                   12450:         }
                   12451:     } else {
1.561     www      12452:         my $separator=',';
1.480     banghart 12453:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12454:             $separator=';';
1.480     banghart 12455:         }
1.31      albertel 12456:         my $i=0;
1.561     www      12457: # the character we are looking for to indicate the end of a quote or a record 
                   12458:         my $looking_for=$separator;
                   12459: # do not add the characters to the fields
                   12460:         my $ignore=0;
                   12461: # we just encountered a separator (or the beginning of the record)
                   12462:         my $just_found_separator=1;
                   12463: # store the field we are working on here
                   12464:         my $field='';
                   12465: # work our way through all characters in record
                   12466:         foreach my $character ($record=~/(.)/g) {
                   12467:             if ($character eq $looking_for) {
                   12468:                if ($character ne $separator) {
                   12469: # Found the end of a quote, again looking for separator
                   12470:                   $looking_for=$separator;
                   12471:                   $ignore=1;
                   12472:                } else {
                   12473: # Found a separator, store away what we got
                   12474:                   $components{&takeleft($i)}=$field;
                   12475: 	          $i++;
                   12476:                   $just_found_separator=1;
                   12477:                   $ignore=0;
                   12478:                   $field='';
                   12479:                }
                   12480:                next;
                   12481:             }
                   12482: # single or double quotation marks after a separator indicate beginning of a quote
                   12483: # we are now looking for the end of the quote and need to ignore separators
                   12484:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12485:                $looking_for=$character;
                   12486:                next;
                   12487:             }
                   12488: # ignore would be true after we reached the end of a quote
                   12489:             if ($ignore) { next; }
                   12490:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   12491:             $field.=$character;
                   12492:             $just_found_separator=0; 
1.31      albertel 12493:         }
1.561     www      12494: # catch the very last entry, since we never encountered the separator
                   12495:         $components{&takeleft($i)}=$field;
1.31      albertel 12496:     }
                   12497:     return %components;
                   12498: }
                   12499: 
1.144     matthew  12500: ######################################################
                   12501: ######################################################
                   12502: 
1.56      matthew  12503: =pod
                   12504: 
1.648     raeburn  12505: =item * &upfile_select_html()
1.41      ng       12506: 
1.144     matthew  12507: Return HTML code to select a file from the users machine and specify 
                   12508: the file type.
1.41      ng       12509: 
                   12510: =cut
                   12511: 
1.144     matthew  12512: ######################################################
                   12513: ######################################################
1.31      albertel 12514: sub upfile_select_html {
1.144     matthew  12515:     my %Types = (
                   12516:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 12517:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  12518:                  space => &mt('Space separated'),
                   12519:                  tab   => &mt('Tabulator separated'),
                   12520: #                 xml   => &mt('HTML/XML'),
                   12521:                  );
                   12522:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  12523:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  12524:     foreach my $type (sort(keys(%Types))) {
                   12525:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   12526:     }
                   12527:     $Str .= "</select>\n";
                   12528:     return $Str;
1.31      albertel 12529: }
                   12530: 
1.301     albertel 12531: sub get_samples {
                   12532:     my ($records,$toget) = @_;
                   12533:     my @samples=({});
                   12534:     my $got=0;
                   12535:     foreach my $rec (@$records) {
                   12536: 	my %temp = &record_sep($rec);
                   12537: 	if (! grep(/\S/, values(%temp))) { next; }
                   12538: 	if (%temp) {
                   12539: 	    $samples[$got]=\%temp;
                   12540: 	    $got++;
                   12541: 	    if ($got == $toget) { last; }
                   12542: 	}
                   12543:     }
                   12544:     return \@samples;
                   12545: }
                   12546: 
1.144     matthew  12547: ######################################################
                   12548: ######################################################
                   12549: 
1.56      matthew  12550: =pod
                   12551: 
1.648     raeburn  12552: =item * &csv_print_samples($r,$records)
1.41      ng       12553: 
                   12554: Prints a table of sample values from each column uploaded $r is an
                   12555: Apache Request ref, $records is an arrayref from
                   12556: &Apache::loncommon::upfile_record_sep
                   12557: 
                   12558: =cut
                   12559: 
1.144     matthew  12560: ######################################################
                   12561: ######################################################
1.31      albertel 12562: sub csv_print_samples {
                   12563:     my ($r,$records) = @_;
1.662     bisitz   12564:     my $samples = &get_samples($records,5);
1.301     albertel 12565: 
1.594     raeburn  12566:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12567:               &start_data_table_header_row());
1.356     albertel 12568:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12569:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12570:     $r->print(&end_data_table_header_row());
1.301     albertel 12571:     foreach my $hash (@$samples) {
1.594     raeburn  12572: 	$r->print(&start_data_table_row());
1.356     albertel 12573: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12574: 	    $r->print('<td>');
1.356     albertel 12575: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12576: 	    $r->print('</td>');
                   12577: 	}
1.594     raeburn  12578: 	$r->print(&end_data_table_row());
1.31      albertel 12579:     }
1.594     raeburn  12580:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12581: }
                   12582: 
1.144     matthew  12583: ######################################################
                   12584: ######################################################
                   12585: 
1.56      matthew  12586: =pod
                   12587: 
1.648     raeburn  12588: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12589: 
                   12590: Prints a table to create associations between values and table columns.
1.144     matthew  12591: 
1.41      ng       12592: $r is an Apache Request ref,
                   12593: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12594: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12595: 
                   12596: =cut
                   12597: 
1.144     matthew  12598: ######################################################
                   12599: ######################################################
1.31      albertel 12600: sub csv_print_select_table {
                   12601:     my ($r,$records,$d) = @_;
1.301     albertel 12602:     my $i=0;
                   12603:     my $samples = &get_samples($records,1);
1.144     matthew  12604:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12605: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12606:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12607:               '<th>'.&mt('Column').'</th>'.
                   12608:               &end_data_table_header_row()."\n");
1.356     albertel 12609:     foreach my $array_ref (@$d) {
                   12610: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12611: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12612: 
1.875     bisitz   12613: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12614: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12615: 	$r->print('<option value="none"></option>');
1.356     albertel 12616: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12617: 	    $r->print('<option value="'.$sample.'"'.
                   12618:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12619:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12620: 	}
1.594     raeburn  12621: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12622: 	$i++;
                   12623:     }
1.594     raeburn  12624:     $r->print(&end_data_table());
1.31      albertel 12625:     $i--;
                   12626:     return $i;
                   12627: }
1.56      matthew  12628: 
1.144     matthew  12629: ######################################################
                   12630: ######################################################
                   12631: 
1.56      matthew  12632: =pod
1.31      albertel 12633: 
1.648     raeburn  12634: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12635: 
                   12636: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12637: 
                   12638: $r is an Apache Request ref,
                   12639: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12640: $d is an array of 2 element arrays (internal name, displayed name)
                   12641: 
                   12642: =cut
                   12643: 
1.144     matthew  12644: ######################################################
                   12645: ######################################################
1.31      albertel 12646: sub csv_samples_select_table {
                   12647:     my ($r,$records,$d) = @_;
                   12648:     my $i=0;
1.144     matthew  12649:     #
1.662     bisitz   12650:     my $max_samples = 5;
                   12651:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12652:     $r->print(&start_data_table().
                   12653:               &start_data_table_header_row().'<th>'.
                   12654:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12655:               &end_data_table_header_row());
1.301     albertel 12656: 
                   12657:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12658: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12659: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12660: 	foreach my $option (@$d) {
                   12661: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12662: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12663:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12664:                       $display.'</option>');
1.31      albertel 12665: 	}
                   12666: 	$r->print('</select></td><td>');
1.662     bisitz   12667: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12668: 	    if (defined($samples->[$line]{$key})) { 
                   12669: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12670: 	    }
                   12671: 	}
1.594     raeburn  12672: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12673: 	$i++;
                   12674:     }
1.594     raeburn  12675:     $r->print(&end_data_table());
1.31      albertel 12676:     $i--;
                   12677:     return($i);
1.115     matthew  12678: }
                   12679: 
1.144     matthew  12680: ######################################################
                   12681: ######################################################
                   12682: 
1.115     matthew  12683: =pod
                   12684: 
1.648     raeburn  12685: =item * &clean_excel_name($name)
1.115     matthew  12686: 
                   12687: Returns a replacement for $name which does not contain any illegal characters.
                   12688: 
                   12689: =cut
                   12690: 
1.144     matthew  12691: ######################################################
                   12692: ######################################################
1.115     matthew  12693: sub clean_excel_name {
                   12694:     my ($name) = @_;
                   12695:     $name =~ s/[:\*\?\/\\]//g;
                   12696:     if (length($name) > 31) {
                   12697:         $name = substr($name,0,31);
                   12698:     }
                   12699:     return $name;
1.25      albertel 12700: }
1.84      albertel 12701: 
1.85      albertel 12702: =pod
                   12703: 
1.648     raeburn  12704: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12705: 
                   12706: Returns either 1 or undef
                   12707: 
                   12708: 1 if the part is to be hidden, undef if it is to be shown
                   12709: 
                   12710: Arguments are:
                   12711: 
                   12712: $id the id of the part to be checked
                   12713: $symb, optional the symb of the resource to check
                   12714: $udom, optional the domain of the user to check for
                   12715: $uname, optional the username of the user to check for
                   12716: 
                   12717: =cut
1.84      albertel 12718: 
                   12719: sub check_if_partid_hidden {
                   12720:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12721:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12722: 					 $symb,$udom,$uname);
1.141     albertel 12723:     my $truth=1;
                   12724:     #if the string starts with !, then the list is the list to show not hide
                   12725:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12726:     my @hiddenlist=split(/,/,$hiddenparts);
                   12727:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12728: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12729:     }
1.141     albertel 12730:     return !$truth;
1.84      albertel 12731: }
1.127     matthew  12732: 
1.138     matthew  12733: 
                   12734: ############################################################
                   12735: ############################################################
                   12736: 
                   12737: =pod
                   12738: 
1.157     matthew  12739: =back 
                   12740: 
1.138     matthew  12741: =head1 cgi-bin script and graphing routines
                   12742: 
1.157     matthew  12743: =over 4
                   12744: 
1.648     raeburn  12745: =item * &get_cgi_id()
1.138     matthew  12746: 
                   12747: Inputs: none
                   12748: 
                   12749: Returns an id which can be used to pass environment variables
                   12750: to various cgi-bin scripts.  These environment variables will
                   12751: be removed from the users environment after a given time by
                   12752: the routine &Apache::lonnet::transfer_profile_to_env.
                   12753: 
                   12754: =cut
                   12755: 
                   12756: ############################################################
                   12757: ############################################################
1.152     albertel 12758: my $uniq=0;
1.136     matthew  12759: sub get_cgi_id {
1.154     albertel 12760:     $uniq=($uniq+1)%100000;
1.280     albertel 12761:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12762: }
                   12763: 
1.127     matthew  12764: ############################################################
                   12765: ############################################################
                   12766: 
                   12767: =pod
                   12768: 
1.648     raeburn  12769: =item * &DrawBarGraph()
1.127     matthew  12770: 
1.138     matthew  12771: Facilitates the plotting of data in a (stacked) bar graph.
                   12772: Puts plot definition data into the users environment in order for 
                   12773: graph.png to plot it.  Returns an <img> tag for the plot.
                   12774: The bars on the plot are labeled '1','2',...,'n'.
                   12775: 
                   12776: Inputs:
                   12777: 
                   12778: =over 4
                   12779: 
                   12780: =item $Title: string, the title of the plot
                   12781: 
                   12782: =item $xlabel: string, text describing the X-axis of the plot
                   12783: 
                   12784: =item $ylabel: string, text describing the Y-axis of the plot
                   12785: 
                   12786: =item $Max: scalar, the maximum Y value to use in the plot
                   12787: If $Max is < any data point, the graph will not be rendered.
                   12788: 
1.140     matthew  12789: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12790: they are plotted.  If undefined, default values will be used.
                   12791: 
1.178     matthew  12792: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12793: 
1.138     matthew  12794: =item @Values: An array of array references.  Each array reference holds data
                   12795: to be plotted in a stacked bar chart.
                   12796: 
1.239     matthew  12797: =item If the final element of @Values is a hash reference the key/value
                   12798: pairs will be added to the graph definition.
                   12799: 
1.138     matthew  12800: =back
                   12801: 
                   12802: Returns:
                   12803: 
                   12804: An <img> tag which references graph.png and the appropriate identifying
                   12805: information for the plot.
                   12806: 
1.127     matthew  12807: =cut
                   12808: 
                   12809: ############################################################
                   12810: ############################################################
1.134     matthew  12811: sub DrawBarGraph {
1.178     matthew  12812:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12813:     #
                   12814:     if (! defined($colors)) {
                   12815:         $colors = ['#33ff00', 
                   12816:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12817:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12818:                   ]; 
                   12819:     }
1.228     matthew  12820:     my $extra_settings = {};
                   12821:     if (ref($Values[-1]) eq 'HASH') {
                   12822:         $extra_settings = pop(@Values);
                   12823:     }
1.127     matthew  12824:     #
1.136     matthew  12825:     my $identifier = &get_cgi_id();
                   12826:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12827:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12828:         return '';
                   12829:     }
1.225     matthew  12830:     #
                   12831:     my @Labels;
                   12832:     if (defined($labels)) {
                   12833:         @Labels = @$labels;
                   12834:     } else {
                   12835:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12836:             push (@Labels,$i+1);
                   12837:         }
                   12838:     }
                   12839:     #
1.129     matthew  12840:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12841:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12842:     my %ValuesHash;
                   12843:     my $NumSets=1;
                   12844:     foreach my $array (@Values) {
                   12845:         next if (! ref($array));
1.136     matthew  12846:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12847:             join(',',@$array);
1.129     matthew  12848:     }
1.127     matthew  12849:     #
1.136     matthew  12850:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12851:     if ($NumBars < 3) {
                   12852:         $width = 120+$NumBars*32;
1.220     matthew  12853:         $xskip = 1;
1.225     matthew  12854:         $bar_width = 30;
                   12855:     } elsif ($NumBars < 5) {
                   12856:         $width = 120+$NumBars*20;
                   12857:         $xskip = 1;
                   12858:         $bar_width = 20;
1.220     matthew  12859:     } elsif ($NumBars < 10) {
1.136     matthew  12860:         $width = 120+$NumBars*15;
                   12861:         $xskip = 1;
                   12862:         $bar_width = 15;
                   12863:     } elsif ($NumBars <= 25) {
                   12864:         $width = 120+$NumBars*11;
                   12865:         $xskip = 5;
                   12866:         $bar_width = 8;
                   12867:     } elsif ($NumBars <= 50) {
                   12868:         $width = 120+$NumBars*8;
                   12869:         $xskip = 5;
                   12870:         $bar_width = 4;
                   12871:     } else {
                   12872:         $width = 120+$NumBars*8;
                   12873:         $xskip = 5;
                   12874:         $bar_width = 4;
                   12875:     }
                   12876:     #
1.137     matthew  12877:     $Max = 1 if ($Max < 1);
                   12878:     if ( int($Max) < $Max ) {
                   12879:         $Max++;
                   12880:         $Max = int($Max);
                   12881:     }
1.127     matthew  12882:     $Title  = '' if (! defined($Title));
                   12883:     $xlabel = '' if (! defined($xlabel));
                   12884:     $ylabel = '' if (! defined($ylabel));
1.369     www      12885:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12886:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12887:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12888:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12889:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12890:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12891:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12892:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12893:     $ValuesHash{$id.'.height'}   = $height;
                   12894:     $ValuesHash{$id.'.width'}    = $width;
                   12895:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12896:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12897:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12898:     #
1.228     matthew  12899:     # Deal with other parameters
                   12900:     while (my ($key,$value) = each(%$extra_settings)) {
                   12901:         $ValuesHash{$id.'.'.$key} = $value;
                   12902:     }
                   12903:     #
1.646     raeburn  12904:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12905:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12906: }
                   12907: 
                   12908: ############################################################
                   12909: ############################################################
                   12910: 
                   12911: =pod
                   12912: 
1.648     raeburn  12913: =item * &DrawXYGraph()
1.137     matthew  12914: 
1.138     matthew  12915: Facilitates the plotting of data in an XY graph.
                   12916: Puts plot definition data into the users environment in order for 
                   12917: graph.png to plot it.  Returns an <img> tag for the plot.
                   12918: 
                   12919: Inputs:
                   12920: 
                   12921: =over 4
                   12922: 
                   12923: =item $Title: string, the title of the plot
                   12924: 
                   12925: =item $xlabel: string, text describing the X-axis of the plot
                   12926: 
                   12927: =item $ylabel: string, text describing the Y-axis of the plot
                   12928: 
                   12929: =item $Max: scalar, the maximum Y value to use in the plot
                   12930: If $Max is < any data point, the graph will not be rendered.
                   12931: 
                   12932: =item $colors: Array ref containing the hex color codes for the data to be 
                   12933: plotted in.  If undefined, default values will be used.
                   12934: 
                   12935: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12936: 
                   12937: =item $Ydata: Array ref containing Array refs.  
1.185     www      12938: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12939: 
                   12940: =item %Values: hash indicating or overriding any default values which are 
                   12941: passed to graph.png.  
                   12942: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12943: 
                   12944: =back
                   12945: 
                   12946: Returns:
                   12947: 
                   12948: An <img> tag which references graph.png and the appropriate identifying
                   12949: information for the plot.
                   12950: 
1.137     matthew  12951: =cut
                   12952: 
                   12953: ############################################################
                   12954: ############################################################
                   12955: sub DrawXYGraph {
                   12956:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12957:     #
                   12958:     # Create the identifier for the graph
                   12959:     my $identifier = &get_cgi_id();
                   12960:     my $id = 'cgi.'.$identifier;
                   12961:     #
                   12962:     $Title  = '' if (! defined($Title));
                   12963:     $xlabel = '' if (! defined($xlabel));
                   12964:     $ylabel = '' if (! defined($ylabel));
                   12965:     my %ValuesHash = 
                   12966:         (
1.369     www      12967:          $id.'.title'  => &escape($Title),
                   12968:          $id.'.xlabel' => &escape($xlabel),
                   12969:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12970:          $id.'.y_max_value'=> $Max,
                   12971:          $id.'.labels'     => join(',',@$Xlabels),
                   12972:          $id.'.PlotType'   => 'XY',
                   12973:          );
                   12974:     #
                   12975:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12976:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12977:     }
                   12978:     #
                   12979:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12980:         return '';
                   12981:     }
                   12982:     my $NumSets=1;
1.138     matthew  12983:     foreach my $array (@{$Ydata}){
1.137     matthew  12984:         next if (! ref($array));
                   12985:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12986:     }
1.138     matthew  12987:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12988:     #
                   12989:     # Deal with other parameters
                   12990:     while (my ($key,$value) = each(%Values)) {
                   12991:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12992:     }
                   12993:     #
1.646     raeburn  12994:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12995:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12996: }
                   12997: 
                   12998: ############################################################
                   12999: ############################################################
                   13000: 
                   13001: =pod
                   13002: 
1.648     raeburn  13003: =item * &DrawXYYGraph()
1.138     matthew  13004: 
                   13005: Facilitates the plotting of data in an XY graph with two Y axes.
                   13006: Puts plot definition data into the users environment in order for 
                   13007: graph.png to plot it.  Returns an <img> tag for the plot.
                   13008: 
                   13009: Inputs:
                   13010: 
                   13011: =over 4
                   13012: 
                   13013: =item $Title: string, the title of the plot
                   13014: 
                   13015: =item $xlabel: string, text describing the X-axis of the plot
                   13016: 
                   13017: =item $ylabel: string, text describing the Y-axis of the plot
                   13018: 
                   13019: =item $colors: Array ref containing the hex color codes for the data to be 
                   13020: plotted in.  If undefined, default values will be used.
                   13021: 
                   13022: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13023: 
                   13024: =item $Ydata1: The first data set
                   13025: 
                   13026: =item $Min1: The minimum value of the left Y-axis
                   13027: 
                   13028: =item $Max1: The maximum value of the left Y-axis
                   13029: 
                   13030: =item $Ydata2: The second data set
                   13031: 
                   13032: =item $Min2: The minimum value of the right Y-axis
                   13033: 
                   13034: =item $Max2: The maximum value of the left Y-axis
                   13035: 
                   13036: =item %Values: hash indicating or overriding any default values which are 
                   13037: passed to graph.png.  
                   13038: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13039: 
                   13040: =back
                   13041: 
                   13042: Returns:
                   13043: 
                   13044: An <img> tag which references graph.png and the appropriate identifying
                   13045: information for the plot.
1.136     matthew  13046: 
                   13047: =cut
                   13048: 
                   13049: ############################################################
                   13050: ############################################################
1.137     matthew  13051: sub DrawXYYGraph {
                   13052:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13053:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13054:     #
                   13055:     # Create the identifier for the graph
                   13056:     my $identifier = &get_cgi_id();
                   13057:     my $id = 'cgi.'.$identifier;
                   13058:     #
                   13059:     $Title  = '' if (! defined($Title));
                   13060:     $xlabel = '' if (! defined($xlabel));
                   13061:     $ylabel = '' if (! defined($ylabel));
                   13062:     my %ValuesHash = 
                   13063:         (
1.369     www      13064:          $id.'.title'  => &escape($Title),
                   13065:          $id.'.xlabel' => &escape($xlabel),
                   13066:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13067:          $id.'.labels' => join(',',@$Xlabels),
                   13068:          $id.'.PlotType' => 'XY',
                   13069:          $id.'.NumSets' => 2,
1.137     matthew  13070:          $id.'.two_axes' => 1,
                   13071:          $id.'.y1_max_value' => $Max1,
                   13072:          $id.'.y1_min_value' => $Min1,
                   13073:          $id.'.y2_max_value' => $Max2,
                   13074:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13075:          );
                   13076:     #
1.137     matthew  13077:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13078:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13079:     }
                   13080:     #
                   13081:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13082:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13083:         return '';
                   13084:     }
                   13085:     my $NumSets=1;
1.137     matthew  13086:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13087:         next if (! ref($array));
                   13088:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13089:     }
                   13090:     #
                   13091:     # Deal with other parameters
                   13092:     while (my ($key,$value) = each(%Values)) {
                   13093:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13094:     }
                   13095:     #
1.646     raeburn  13096:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13097:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13098: }
                   13099: 
                   13100: ############################################################
                   13101: ############################################################
                   13102: 
                   13103: =pod
                   13104: 
1.157     matthew  13105: =back 
                   13106: 
1.139     matthew  13107: =head1 Statistics helper routines?  
                   13108: 
                   13109: Bad place for them but what the hell.
                   13110: 
1.157     matthew  13111: =over 4
                   13112: 
1.648     raeburn  13113: =item * &chartlink()
1.139     matthew  13114: 
                   13115: Returns a link to the chart for a specific student.  
                   13116: 
                   13117: Inputs:
                   13118: 
                   13119: =over 4
                   13120: 
                   13121: =item $linktext: The text of the link
                   13122: 
                   13123: =item $sname: The students username
                   13124: 
                   13125: =item $sdomain: The students domain
                   13126: 
                   13127: =back
                   13128: 
1.157     matthew  13129: =back
                   13130: 
1.139     matthew  13131: =cut
                   13132: 
                   13133: ############################################################
                   13134: ############################################################
                   13135: sub chartlink {
                   13136:     my ($linktext, $sname, $sdomain) = @_;
                   13137:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13138:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13139:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13140:        '">'.$linktext.'</a>';
1.153     matthew  13141: }
                   13142: 
                   13143: #######################################################
                   13144: #######################################################
                   13145: 
                   13146: =pod
                   13147: 
                   13148: =head1 Course Environment Routines
1.157     matthew  13149: 
                   13150: =over 4
1.153     matthew  13151: 
1.648     raeburn  13152: =item * &restore_course_settings()
1.153     matthew  13153: 
1.648     raeburn  13154: =item * &store_course_settings()
1.153     matthew  13155: 
                   13156: Restores/Store indicated form parameters from the course environment.
                   13157: Will not overwrite existing values of the form parameters.
                   13158: 
                   13159: Inputs: 
                   13160: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13161: 
                   13162: a hash ref describing the data to be stored.  For example:
                   13163:    
                   13164: %Save_Parameters = ('Status' => 'scalar',
                   13165:     'chartoutputmode' => 'scalar',
                   13166:     'chartoutputdata' => 'scalar',
                   13167:     'Section' => 'array',
1.373     raeburn  13168:     'Group' => 'array',
1.153     matthew  13169:     'StudentData' => 'array',
                   13170:     'Maps' => 'array');
                   13171: 
                   13172: Returns: both routines return nothing
                   13173: 
1.631     raeburn  13174: =back
                   13175: 
1.153     matthew  13176: =cut
                   13177: 
                   13178: #######################################################
                   13179: #######################################################
                   13180: sub store_course_settings {
1.496     albertel 13181:     return &store_settings($env{'request.course.id'},@_);
                   13182: }
                   13183: 
                   13184: sub store_settings {
1.153     matthew  13185:     # save to the environment
                   13186:     # appenv the same items, just to be safe
1.300     albertel 13187:     my $udom  = $env{'user.domain'};
                   13188:     my $uname = $env{'user.name'};
1.496     albertel 13189:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13190:     my %SaveHash;
                   13191:     my %AppHash;
                   13192:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13193:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13194:         my $envname = 'environment.'.$basename;
1.258     albertel 13195:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13196:             # Save this value away
                   13197:             if ($type eq 'scalar' &&
1.258     albertel 13198:                 (! exists($env{$envname}) || 
                   13199:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13200:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13201:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13202:             } elsif ($type eq 'array') {
                   13203:                 my $stored_form;
1.258     albertel 13204:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13205:                     $stored_form = join(',',
                   13206:                                         map {
1.369     www      13207:                                             &escape($_);
1.258     albertel 13208:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13209:                 } else {
                   13210:                     $stored_form = 
1.369     www      13211:                         &escape($env{'form.'.$setting});
1.153     matthew  13212:                 }
                   13213:                 # Determine if the array contents are the same.
1.258     albertel 13214:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13215:                     $SaveHash{$basename} = $stored_form;
                   13216:                     $AppHash{$envname}   = $stored_form;
                   13217:                 }
                   13218:             }
                   13219:         }
                   13220:     }
                   13221:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13222:                                           $udom,$uname);
1.153     matthew  13223:     if ($put_result !~ /^(ok|delayed)/) {
                   13224:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13225:                                  'got error:'.$put_result);
                   13226:     }
                   13227:     # Make sure these settings stick around in this session, too
1.646     raeburn  13228:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13229:     return;
                   13230: }
                   13231: 
                   13232: sub restore_course_settings {
1.499     albertel 13233:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13234: }
                   13235: 
                   13236: sub restore_settings {
                   13237:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13238:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13239:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13240:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13241:             '.'.$setting;
1.258     albertel 13242:         if (exists($env{$envname})) {
1.153     matthew  13243:             if ($type eq 'scalar') {
1.258     albertel 13244:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13245:             } elsif ($type eq 'array') {
1.258     albertel 13246:                 $env{'form.'.$setting} = [ 
1.153     matthew  13247:                                            map { 
1.369     www      13248:                                                &unescape($_); 
1.258     albertel 13249:                                            } split(',',$env{$envname})
1.153     matthew  13250:                                            ];
                   13251:             }
                   13252:         }
                   13253:     }
1.127     matthew  13254: }
                   13255: 
1.618     raeburn  13256: #######################################################
                   13257: #######################################################
                   13258: 
                   13259: =pod
                   13260: 
                   13261: =head1 Domain E-mail Routines  
                   13262: 
                   13263: =over 4
                   13264: 
1.648     raeburn  13265: =item * &build_recipient_list()
1.618     raeburn  13266: 
1.1075.2.44  raeburn  13267: Build recipient lists for following types of e-mail:
1.766     raeburn  13268: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44  raeburn  13269: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   13270: module change checking, student/employee ID conflict checks, as
                   13271: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   13272: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  13273: 
                   13274: Inputs:
1.1075.2.44  raeburn  13275: defmail (scalar - email address of default recipient),
                   13276: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   13277: requestsmail, updatesmail, or idconflictsmail).
                   13278: 
1.619     raeburn  13279: defdom (domain for which to retrieve configuration settings),
1.1075.2.44  raeburn  13280: 
                   13281: origmail (scalar - email address of recipient from loncapa.conf,
                   13282: i.e., predates configuration by DC via domainprefs.pm
1.618     raeburn  13283: 
1.655     raeburn  13284: Returns: comma separated list of addresses to which to send e-mail.
                   13285: 
                   13286: =back
1.618     raeburn  13287: 
                   13288: =cut
                   13289: 
                   13290: ############################################################
                   13291: ############################################################
                   13292: sub build_recipient_list {
1.619     raeburn  13293:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13294:     my @recipients;
                   13295:     my $otheremails;
                   13296:     my %domconfig =
                   13297:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13298:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13299:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13300:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13301:                 my @contacts = ('adminemail','supportemail');
                   13302:                 foreach my $item (@contacts) {
                   13303:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13304:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13305:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13306:                             push(@recipients,$addr);
                   13307:                         }
1.619     raeburn  13308:                     }
1.766     raeburn  13309:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13310:                 }
                   13311:             }
1.766     raeburn  13312:         } elsif ($origmail ne '') {
                   13313:             push(@recipients,$origmail);
1.618     raeburn  13314:         }
1.619     raeburn  13315:     } elsif ($origmail ne '') {
                   13316:         push(@recipients,$origmail);
1.618     raeburn  13317:     }
1.688     raeburn  13318:     if (defined($defmail)) {
                   13319:         if ($defmail ne '') {
                   13320:             push(@recipients,$defmail);
                   13321:         }
1.618     raeburn  13322:     }
                   13323:     if ($otheremails) {
1.619     raeburn  13324:         my @others;
                   13325:         if ($otheremails =~ /,/) {
                   13326:             @others = split(/,/,$otheremails);
1.618     raeburn  13327:         } else {
1.619     raeburn  13328:             push(@others,$otheremails);
                   13329:         }
                   13330:         foreach my $addr (@others) {
                   13331:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13332:                 push(@recipients,$addr);
                   13333:             }
1.618     raeburn  13334:         }
                   13335:     }
1.619     raeburn  13336:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13337:     return $recipientlist;
                   13338: }
                   13339: 
1.127     matthew  13340: ############################################################
                   13341: ############################################################
1.154     albertel 13342: 
1.655     raeburn  13343: =pod
                   13344: 
                   13345: =head1 Course Catalog Routines
                   13346: 
                   13347: =over 4
                   13348: 
                   13349: =item * &gather_categories()
                   13350: 
                   13351: Converts category definitions - keys of categories hash stored in  
                   13352: coursecategories in configuration.db on the primary library server in a 
                   13353: domain - to an array.  Also generates javascript and idx hash used to 
                   13354: generate Domain Coordinator interface for editing Course Categories.
                   13355: 
                   13356: Inputs:
1.663     raeburn  13357: 
1.655     raeburn  13358: categories (reference to hash of category definitions).
1.663     raeburn  13359: 
1.655     raeburn  13360: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13361:       categories and subcategories).
1.663     raeburn  13362: 
1.655     raeburn  13363: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13364:       editing Course Categories).
1.663     raeburn  13365: 
1.655     raeburn  13366: jsarray (reference to array of categories used to create Javascript arrays for
                   13367:          Domain Coordinator interface for editing Course Categories).
                   13368: 
                   13369: Returns: nothing
                   13370: 
                   13371: Side effects: populates cats, idx and jsarray. 
                   13372: 
                   13373: =cut
                   13374: 
                   13375: sub gather_categories {
                   13376:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13377:     my %counters;
                   13378:     my $num = 0;
                   13379:     foreach my $item (keys(%{$categories})) {
                   13380:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13381:         if ($container eq '' && $depth == 0) {
                   13382:             $cats->[$depth][$categories->{$item}] = $cat;
                   13383:         } else {
                   13384:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13385:         }
                   13386:         my ($escitem,$tail) = split(/:/,$item,2);
                   13387:         if ($counters{$tail} eq '') {
                   13388:             $counters{$tail} = $num;
                   13389:             $num ++;
                   13390:         }
                   13391:         if (ref($idx) eq 'HASH') {
                   13392:             $idx->{$item} = $counters{$tail};
                   13393:         }
                   13394:         if (ref($jsarray) eq 'ARRAY') {
                   13395:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13396:         }
                   13397:     }
                   13398:     return;
                   13399: }
                   13400: 
                   13401: =pod
                   13402: 
                   13403: =item * &extract_categories()
                   13404: 
                   13405: Used to generate breadcrumb trails for course categories.
                   13406: 
                   13407: Inputs:
1.663     raeburn  13408: 
1.655     raeburn  13409: categories (reference to hash of category definitions).
1.663     raeburn  13410: 
1.655     raeburn  13411: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13412:       categories and subcategories).
1.663     raeburn  13413: 
1.655     raeburn  13414: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  13415: 
1.655     raeburn  13416: allitems (reference to hash - key is category key 
                   13417:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13418: 
1.655     raeburn  13419: idx (reference to hash of counters used in Domain Coordinator interface for
                   13420:       editing Course Categories).
1.663     raeburn  13421: 
1.655     raeburn  13422: jsarray (reference to array of categories used to create Javascript arrays for
                   13423:          Domain Coordinator interface for editing Course Categories).
                   13424: 
1.665     raeburn  13425: subcats (reference to hash of arrays containing all subcategories within each 
                   13426:          category, -recursive)
                   13427: 
1.655     raeburn  13428: Returns: nothing
                   13429: 
                   13430: Side effects: populates trails and allitems hash references.
                   13431: 
                   13432: =cut
                   13433: 
                   13434: sub extract_categories {
1.665     raeburn  13435:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  13436:     if (ref($categories) eq 'HASH') {
                   13437:         &gather_categories($categories,$cats,$idx,$jsarray);
                   13438:         if (ref($cats->[0]) eq 'ARRAY') {
                   13439:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   13440:                 my $name = $cats->[0][$i];
                   13441:                 my $item = &escape($name).'::0';
                   13442:                 my $trailstr;
                   13443:                 if ($name eq 'instcode') {
                   13444:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  13445:                 } elsif ($name eq 'communities') {
                   13446:                     $trailstr = &mt('Communities');
1.655     raeburn  13447:                 } else {
                   13448:                     $trailstr = $name;
                   13449:                 }
                   13450:                 if ($allitems->{$item} eq '') {
                   13451:                     push(@{$trails},$trailstr);
                   13452:                     $allitems->{$item} = scalar(@{$trails})-1;
                   13453:                 }
                   13454:                 my @parents = ($name);
                   13455:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   13456:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   13457:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  13458:                         if (ref($subcats) eq 'HASH') {
                   13459:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   13460:                         }
                   13461:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   13462:                     }
                   13463:                 } else {
                   13464:                     if (ref($subcats) eq 'HASH') {
                   13465:                         $subcats->{$item} = [];
1.655     raeburn  13466:                     }
                   13467:                 }
                   13468:             }
                   13469:         }
                   13470:     }
                   13471:     return;
                   13472: }
                   13473: 
                   13474: =pod
                   13475: 
1.1075.2.56  raeburn  13476: =item * &recurse_categories()
1.655     raeburn  13477: 
                   13478: Recursively used to generate breadcrumb trails for course categories.
                   13479: 
                   13480: Inputs:
1.663     raeburn  13481: 
1.655     raeburn  13482: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13483:       categories and subcategories).
1.663     raeburn  13484: 
1.655     raeburn  13485: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  13486: 
                   13487: category (current course category, for which breadcrumb trail is being generated).
                   13488: 
                   13489: trails (reference to array of breadcrumb trails for each category).
                   13490: 
1.655     raeburn  13491: allitems (reference to hash - key is category key
                   13492:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13493: 
1.655     raeburn  13494: parents (array containing containers directories for current category, 
                   13495:          back to top level). 
                   13496: 
                   13497: Returns: nothing
                   13498: 
                   13499: Side effects: populates trails and allitems hash references
                   13500: 
                   13501: =cut
                   13502: 
                   13503: sub recurse_categories {
1.665     raeburn  13504:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  13505:     my $shallower = $depth - 1;
                   13506:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   13507:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   13508:             my $name = $cats->[$depth]{$category}[$k];
                   13509:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13510:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13511:             if ($allitems->{$item} eq '') {
                   13512:                 push(@{$trails},$trailstr);
                   13513:                 $allitems->{$item} = scalar(@{$trails})-1;
                   13514:             }
                   13515:             my $deeper = $depth+1;
                   13516:             push(@{$parents},$category);
1.665     raeburn  13517:             if (ref($subcats) eq 'HASH') {
                   13518:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   13519:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   13520:                     my $higher;
                   13521:                     if ($j > 0) {
                   13522:                         $higher = &escape($parents->[$j]).':'.
                   13523:                                   &escape($parents->[$j-1]).':'.$j;
                   13524:                     } else {
                   13525:                         $higher = &escape($parents->[$j]).'::'.$j;
                   13526:                     }
                   13527:                     push(@{$subcats->{$higher}},$subcat);
                   13528:                 }
                   13529:             }
                   13530:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   13531:                                 $subcats);
1.655     raeburn  13532:             pop(@{$parents});
                   13533:         }
                   13534:     } else {
                   13535:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13536:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13537:         if ($allitems->{$item} eq '') {
                   13538:             push(@{$trails},$trailstr);
                   13539:             $allitems->{$item} = scalar(@{$trails})-1;
                   13540:         }
                   13541:     }
                   13542:     return;
                   13543: }
                   13544: 
1.663     raeburn  13545: =pod
                   13546: 
1.1075.2.56  raeburn  13547: =item * &assign_categories_table()
1.663     raeburn  13548: 
                   13549: Create a datatable for display of hierarchical categories in a domain,
                   13550: with checkboxes to allow a course to be categorized. 
                   13551: 
                   13552: Inputs:
                   13553: 
                   13554: cathash - reference to hash of categories defined for the domain (from
                   13555:           configuration.db)
                   13556: 
                   13557: currcat - scalar with an & separated list of categories assigned to a course. 
                   13558: 
1.919     raeburn  13559: type    - scalar contains course type (Course or Community).
                   13560: 
1.663     raeburn  13561: Returns: $output (markup to be displayed) 
                   13562: 
                   13563: =cut
                   13564: 
                   13565: sub assign_categories_table {
1.919     raeburn  13566:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13567:     my $output;
                   13568:     if (ref($cathash) eq 'HASH') {
                   13569:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13570:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13571:         $maxdepth = scalar(@cats);
                   13572:         if (@cats > 0) {
                   13573:             my $itemcount = 0;
                   13574:             if (ref($cats[0]) eq 'ARRAY') {
                   13575:                 my @currcategories;
                   13576:                 if ($currcat ne '') {
                   13577:                     @currcategories = split('&',$currcat);
                   13578:                 }
1.919     raeburn  13579:                 my $table;
1.663     raeburn  13580:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13581:                     my $parent = $cats[0][$i];
1.919     raeburn  13582:                     next if ($parent eq 'instcode');
                   13583:                     if ($type eq 'Community') {
                   13584:                         next unless ($parent eq 'communities');
                   13585:                     } else {
                   13586:                         next if ($parent eq 'communities');
                   13587:                     }
1.663     raeburn  13588:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13589:                     my $item = &escape($parent).'::0';
                   13590:                     my $checked = '';
                   13591:                     if (@currcategories > 0) {
                   13592:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13593:                             $checked = ' checked="checked"';
1.663     raeburn  13594:                         }
                   13595:                     }
1.919     raeburn  13596:                     my $parent_title = $parent;
                   13597:                     if ($parent eq 'communities') {
                   13598:                         $parent_title = &mt('Communities');
                   13599:                     }
                   13600:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13601:                               '<input type="checkbox" name="usecategory" value="'.
                   13602:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13603:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13604:                     my $depth = 1;
                   13605:                     push(@path,$parent);
1.919     raeburn  13606:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13607:                     pop(@path);
1.919     raeburn  13608:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13609:                     $itemcount ++;
                   13610:                 }
1.919     raeburn  13611:                 if ($itemcount) {
                   13612:                     $output = &Apache::loncommon::start_data_table().
                   13613:                               $table.
                   13614:                               &Apache::loncommon::end_data_table();
                   13615:                 }
1.663     raeburn  13616:             }
                   13617:         }
                   13618:     }
                   13619:     return $output;
                   13620: }
                   13621: 
                   13622: =pod
                   13623: 
1.1075.2.56  raeburn  13624: =item * &assign_category_rows()
1.663     raeburn  13625: 
                   13626: Create a datatable row for display of nested categories in a domain,
                   13627: with checkboxes to allow a course to be categorized,called recursively.
                   13628: 
                   13629: Inputs:
                   13630: 
                   13631: itemcount - track row number for alternating colors
                   13632: 
                   13633: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13634:       categories and subcategories.
                   13635: 
                   13636: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13637: 
                   13638: parent - parent of current category item
                   13639: 
                   13640: path - Array containing all categories back up through the hierarchy from the
                   13641:        current category to the top level.
                   13642: 
                   13643: currcategories - reference to array of current categories assigned to the course
                   13644: 
                   13645: Returns: $output (markup to be displayed).
                   13646: 
                   13647: =cut
                   13648: 
                   13649: sub assign_category_rows {
                   13650:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13651:     my ($text,$name,$item,$chgstr);
                   13652:     if (ref($cats) eq 'ARRAY') {
                   13653:         my $maxdepth = scalar(@{$cats});
                   13654:         if (ref($cats->[$depth]) eq 'HASH') {
                   13655:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13656:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13657:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45  raeburn  13658:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  13659:                 for (my $j=0; $j<$numchildren; $j++) {
                   13660:                     $name = $cats->[$depth]{$parent}[$j];
                   13661:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13662:                     my $deeper = $depth+1;
                   13663:                     my $checked = '';
                   13664:                     if (ref($currcategories) eq 'ARRAY') {
                   13665:                         if (@{$currcategories} > 0) {
                   13666:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13667:                                 $checked = ' checked="checked"';
1.663     raeburn  13668:                             }
                   13669:                         }
                   13670:                     }
1.664     raeburn  13671:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13672:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13673:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13674:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13675:                              '</td><td>';
1.663     raeburn  13676:                     if (ref($path) eq 'ARRAY') {
                   13677:                         push(@{$path},$name);
                   13678:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13679:                         pop(@{$path});
                   13680:                     }
                   13681:                     $text .= '</td></tr>';
                   13682:                 }
                   13683:                 $text .= '</table></td>';
                   13684:             }
                   13685:         }
                   13686:     }
                   13687:     return $text;
                   13688: }
                   13689: 
1.1075.2.69  raeburn  13690: =pod
                   13691: 
                   13692: =back
                   13693: 
                   13694: =cut
                   13695: 
1.655     raeburn  13696: ############################################################
                   13697: ############################################################
                   13698: 
                   13699: 
1.443     albertel 13700: sub commit_customrole {
1.664     raeburn  13701:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13702:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13703:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13704:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13705:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13706:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13707:                  '</b><br />';
                   13708:     return $output;
                   13709: }
                   13710: 
                   13711: sub commit_standardrole {
1.1075.2.31  raeburn  13712:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  13713:     my ($output,$logmsg,$linefeed);
                   13714:     if ($context eq 'auto') {
                   13715:         $linefeed = "\n";
                   13716:     } else {
                   13717:         $linefeed = "<br />\n";
                   13718:     }  
1.443     albertel 13719:     if ($three eq 'st') {
1.541     raeburn  13720:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31  raeburn  13721:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  13722:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13723:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13724:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13725:         } else {
1.541     raeburn  13726:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13727:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13728:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13729:             if ($context eq 'auto') {
                   13730:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13731:             } else {
                   13732:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13733:                &mt('Add to classlist').': <b>ok</b>';
                   13734:             }
                   13735:             $output .= $linefeed;
1.443     albertel 13736:         }
                   13737:     } else {
                   13738:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13739:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13740:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13741:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13742:         if ($context eq 'auto') {
                   13743:             $output .= $result.$linefeed;
                   13744:         } else {
                   13745:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13746:         }
1.443     albertel 13747:     }
                   13748:     return $output;
                   13749: }
                   13750: 
                   13751: sub commit_studentrole {
1.1075.2.31  raeburn  13752:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   13753:         $credits) = @_;
1.626     raeburn  13754:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13755:     if ($context eq 'auto') {
                   13756:         $linefeed = "\n";
                   13757:     } else {
                   13758:         $linefeed = '<br />'."\n";
                   13759:     }
1.443     albertel 13760:     if (defined($one) && defined($two)) {
                   13761:         my $cid=$one.'_'.$two;
                   13762:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13763:         my $secchange = 0;
                   13764:         my $expire_role_result;
                   13765:         my $modify_section_result;
1.628     raeburn  13766:         if ($oldsec ne '-1') { 
                   13767:             if ($oldsec ne $sec) {
1.443     albertel 13768:                 $secchange = 1;
1.628     raeburn  13769:                 my $now = time;
1.443     albertel 13770:                 my $uurl='/'.$cid;
                   13771:                 $uurl=~s/\_/\//g;
                   13772:                 if ($oldsec) {
                   13773:                     $uurl.='/'.$oldsec;
                   13774:                 }
1.626     raeburn  13775:                 $oldsecurl = $uurl;
1.628     raeburn  13776:                 $expire_role_result = 
1.652     raeburn  13777:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13778:                 if ($env{'request.course.sec'} ne '') { 
                   13779:                     if ($expire_role_result eq 'refused') {
                   13780:                         my @roles = ('st');
                   13781:                         my @statuses = ('previous');
                   13782:                         my @roledoms = ($one);
                   13783:                         my $withsec = 1;
                   13784:                         my %roleshash = 
                   13785:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13786:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13787:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13788:                             my ($oldstart,$oldend) = 
                   13789:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13790:                             if ($oldend > 0 && $oldend <= $now) {
                   13791:                                 $expire_role_result = 'ok';
                   13792:                             }
                   13793:                         }
                   13794:                     }
                   13795:                 }
1.443     albertel 13796:                 $result = $expire_role_result;
                   13797:             }
                   13798:         }
                   13799:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31  raeburn  13800:             $modify_section_result = 
                   13801:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   13802:                                                            undef,undef,undef,$sec,
                   13803:                                                            $end,$start,'','',$cid,
                   13804:                                                            '',$context,$credits);
1.443     albertel 13805:             if ($modify_section_result =~ /^ok/) {
                   13806:                 if ($secchange == 1) {
1.628     raeburn  13807:                     if ($sec eq '') {
                   13808:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13809:                     } else {
                   13810:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13811:                     }
1.443     albertel 13812:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13813:                     if ($sec eq '') {
                   13814:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13815:                     } else {
                   13816:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13817:                     }
1.443     albertel 13818:                 } else {
1.628     raeburn  13819:                     if ($sec eq '') {
                   13820:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13821:                     } else {
                   13822:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13823:                     }
1.443     albertel 13824:                 }
                   13825:             } else {
1.628     raeburn  13826:                 if ($secchange) {       
                   13827:                     $$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;
                   13828:                 } else {
                   13829:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13830:                 }
1.443     albertel 13831:             }
                   13832:             $result = $modify_section_result;
                   13833:         } elsif ($secchange == 1) {
1.628     raeburn  13834:             if ($oldsec eq '') {
1.1075.2.20  raeburn  13835:                 $$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  13836:             } else {
                   13837:                 $$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;
                   13838:             }
1.626     raeburn  13839:             if ($expire_role_result eq 'refused') {
                   13840:                 my $newsecurl = '/'.$cid;
                   13841:                 $newsecurl =~ s/\_/\//g;
                   13842:                 if ($sec ne '') {
                   13843:                     $newsecurl.='/'.$sec;
                   13844:                 }
                   13845:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13846:                     if ($sec eq '') {
                   13847:                         $$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;
                   13848:                     } else {
                   13849:                         $$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;
                   13850:                     }
                   13851:                 }
                   13852:             }
1.443     albertel 13853:         }
                   13854:     } else {
1.626     raeburn  13855:         $$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 13856:         $result = "error: incomplete course id\n";
                   13857:     }
                   13858:     return $result;
                   13859: }
                   13860: 
1.1075.2.25  raeburn  13861: sub show_role_extent {
                   13862:     my ($scope,$context,$role) = @_;
                   13863:     $scope =~ s{^/}{};
                   13864:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   13865:     push(@courseroles,'co');
                   13866:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   13867:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   13868:         $scope =~ s{/}{_};
                   13869:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   13870:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   13871:         my ($audom,$auname) = split(/\//,$scope);
                   13872:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   13873:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   13874:     } else {
                   13875:         $scope =~ s{/$}{};
                   13876:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   13877:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   13878:     }
                   13879: }
                   13880: 
1.443     albertel 13881: ############################################################
                   13882: ############################################################
                   13883: 
1.566     albertel 13884: sub check_clone {
1.578     raeburn  13885:     my ($args,$linefeed) = @_;
1.566     albertel 13886:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13887:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13888:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13889:     my $clonemsg;
                   13890:     my $can_clone = 0;
1.944     raeburn  13891:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13892:     if ($lctype ne 'community') {
                   13893:         $lctype = 'course';
                   13894:     }
1.566     albertel 13895:     if ($clonehome eq 'no_host') {
1.944     raeburn  13896:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13897:             $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'});
                   13898:         } else {
                   13899:             $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'});
                   13900:         }     
1.566     albertel 13901:     } else {
                   13902: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13903:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13904:             if ($clonedesc{'type'} ne 'Community') {
                   13905:                  $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'});
                   13906:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13907:             }
                   13908:         }
1.882     raeburn  13909: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13910:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13911: 	    $can_clone = 1;
                   13912: 	} else {
                   13913: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13914: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13915: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13916:             if (grep(/^\*$/,@cloners)) {
                   13917:                 $can_clone = 1;
                   13918:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13919:                 $can_clone = 1;
                   13920:             } else {
1.908     raeburn  13921:                 my $ccrole = 'cc';
1.944     raeburn  13922:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13923:                     $ccrole = 'co';
                   13924:                 }
1.578     raeburn  13925: 	        my %roleshash =
                   13926: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13927: 					 $args->{'ccdomain'},
1.908     raeburn  13928:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13929: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13930: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13931:                     $can_clone = 1;
                   13932:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13933:                     $can_clone = 1;
                   13934:                 } else {
1.944     raeburn  13935:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13936:                         $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'});
                   13937:                     } else {
                   13938:                         $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'});
                   13939:                     }
1.578     raeburn  13940: 	        }
1.566     albertel 13941: 	    }
1.578     raeburn  13942:         }
1.566     albertel 13943:     }
                   13944:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13945: }
                   13946: 
1.444     albertel 13947: sub construct_course {
1.1075.2.59  raeburn  13948:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444     albertel 13949:     my $outcome;
1.541     raeburn  13950:     my $linefeed =  '<br />'."\n";
                   13951:     if ($context eq 'auto') {
                   13952:         $linefeed = "\n";
                   13953:     }
1.566     albertel 13954: 
                   13955: #
                   13956: # Are we cloning?
                   13957: #
                   13958:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13959:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13960: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13961: 	if ($context ne 'auto') {
1.578     raeburn  13962:             if ($clonemsg ne '') {
                   13963: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13964:             }
1.566     albertel 13965: 	}
                   13966: 	$outcome .= $clonemsg.$linefeed;
                   13967: 
                   13968:         if (!$can_clone) {
                   13969: 	    return (0,$outcome);
                   13970: 	}
                   13971:     }
                   13972: 
1.444     albertel 13973: #
                   13974: # Open course
                   13975: #
                   13976:     my $crstype = lc($args->{'crstype'});
                   13977:     my %cenv=();
                   13978:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13979:                                              $args->{'cdescr'},
                   13980:                                              $args->{'curl'},
                   13981:                                              $args->{'course_home'},
                   13982:                                              $args->{'nonstandard'},
                   13983:                                              $args->{'crscode'},
                   13984:                                              $args->{'ccuname'}.':'.
                   13985:                                              $args->{'ccdomain'},
1.882     raeburn  13986:                                              $args->{'crstype'},
1.885     raeburn  13987:                                              $cnum,$context,$category);
1.444     albertel 13988: 
                   13989:     # Note: The testing routines depend on this being output; see 
                   13990:     # Utils::Course. This needs to at least be output as a comment
                   13991:     # if anyone ever decides to not show this, and Utils::Course::new
                   13992:     # will need to be suitably modified.
1.541     raeburn  13993:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13994:     if ($$courseid =~ /^error:/) {
                   13995:         return (0,$outcome);
                   13996:     }
                   13997: 
1.444     albertel 13998: #
                   13999: # Check if created correctly
                   14000: #
1.479     albertel 14001:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 14002:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  14003:     if ($crsuhome eq 'no_host') {
                   14004:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   14005:         return (0,$outcome);
                   14006:     }
1.541     raeburn  14007:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 14008: 
1.444     albertel 14009: #
1.566     albertel 14010: # Do the cloning
                   14011: #   
                   14012:     if ($can_clone && $cloneid) {
                   14013: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   14014: 	if ($context ne 'auto') {
                   14015: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   14016: 	}
                   14017: 	$outcome .= $clonemsg.$linefeed;
                   14018: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 14019: # Copy all files
1.637     www      14020: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 14021: # Restore URL
1.566     albertel 14022: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 14023: # Restore title
1.566     albertel 14024: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  14025: # Restore creation date, creator and creation context.
                   14026:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   14027:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   14028:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 14029: # Mark as cloned
1.566     albertel 14030: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      14031: # Need to clone grading mode
                   14032:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   14033:         $cenv{'grading'}=$newenv{'grading'};
                   14034: # Do not clone these environment entries
                   14035:         &Apache::lonnet::del('environment',
                   14036:                   ['default_enrollment_start_date',
                   14037:                    'default_enrollment_end_date',
                   14038:                    'question.email',
                   14039:                    'policy.email',
                   14040:                    'comment.email',
                   14041:                    'pch.users.denied',
1.725     raeburn  14042:                    'plc.users.denied',
                   14043:                    'hidefromcat',
1.1075.2.36  raeburn  14044:                    'checkforpriv',
1.1075.2.59  raeburn  14045:                    'categories',
                   14046:                    'internal.uniquecode'],
1.638     www      14047:                    $$crsudom,$$crsunum);
1.1075.2.63  raeburn  14048:         if ($args->{'textbook'}) {
                   14049:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   14050:         }
1.444     albertel 14051:     }
1.566     albertel 14052: 
1.444     albertel 14053: #
                   14054: # Set environment (will override cloned, if existing)
                   14055: #
                   14056:     my @sections = ();
                   14057:     my @xlists = ();
                   14058:     if ($args->{'crstype'}) {
                   14059:         $cenv{'type'}=$args->{'crstype'};
                   14060:     }
                   14061:     if ($args->{'crsid'}) {
                   14062:         $cenv{'courseid'}=$args->{'crsid'};
                   14063:     }
                   14064:     if ($args->{'crscode'}) {
                   14065:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   14066:     }
                   14067:     if ($args->{'crsquota'} ne '') {
                   14068:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   14069:     } else {
                   14070:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   14071:     }
                   14072:     if ($args->{'ccuname'}) {
                   14073:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   14074:                                         ':'.$args->{'ccdomain'};
                   14075:     } else {
                   14076:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   14077:     }
1.1075.2.31  raeburn  14078:     if ($args->{'defaultcredits'}) {
                   14079:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   14080:     }
1.444     albertel 14081:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   14082:     if ($args->{'crssections'}) {
                   14083:         $cenv{'internal.sectionnums'} = '';
                   14084:         if ($args->{'crssections'} =~ m/,/) {
                   14085:             @sections = split/,/,$args->{'crssections'};
                   14086:         } else {
                   14087:             $sections[0] = $args->{'crssections'};
                   14088:         }
                   14089:         if (@sections > 0) {
                   14090:             foreach my $item (@sections) {
                   14091:                 my ($sec,$gp) = split/:/,$item;
                   14092:                 my $class = $args->{'crscode'}.$sec;
                   14093:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   14094:                 $cenv{'internal.sectionnums'} .= $item.',';
                   14095:                 unless ($addcheck eq 'ok') {
                   14096:                     push @badclasses, $class;
                   14097:                 }
                   14098:             }
                   14099:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   14100:         }
                   14101:     }
                   14102: # do not hide course coordinator from staff listing, 
                   14103: # even if privileged
                   14104:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36  raeburn  14105: # add course coordinator's domain to domains to check for privileged users
                   14106: # if different to course domain
                   14107:     if ($$crsudom ne $args->{'ccdomain'}) {
                   14108:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   14109:     }
1.444     albertel 14110: # add crosslistings
                   14111:     if ($args->{'crsxlist'}) {
                   14112:         $cenv{'internal.crosslistings'}='';
                   14113:         if ($args->{'crsxlist'} =~ m/,/) {
                   14114:             @xlists = split/,/,$args->{'crsxlist'};
                   14115:         } else {
                   14116:             $xlists[0] = $args->{'crsxlist'};
                   14117:         }
                   14118:         if (@xlists > 0) {
                   14119:             foreach my $item (@xlists) {
                   14120:                 my ($xl,$gp) = split/:/,$item;
                   14121:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   14122:                 $cenv{'internal.crosslistings'} .= $item.',';
                   14123:                 unless ($addcheck eq 'ok') {
                   14124:                     push @badclasses, $xl;
                   14125:                 }
                   14126:             }
                   14127:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   14128:         }
                   14129:     }
                   14130:     if ($args->{'autoadds'}) {
                   14131:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   14132:     }
                   14133:     if ($args->{'autodrops'}) {
                   14134:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   14135:     }
                   14136: # check for notification of enrollment changes
                   14137:     my @notified = ();
                   14138:     if ($args->{'notify_owner'}) {
                   14139:         if ($args->{'ccuname'} ne '') {
                   14140:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   14141:         }
                   14142:     }
                   14143:     if ($args->{'notify_dc'}) {
                   14144:         if ($uname ne '') { 
1.630     raeburn  14145:             push(@notified,$uname.':'.$udom);
1.444     albertel 14146:         }
                   14147:     }
                   14148:     if (@notified > 0) {
                   14149:         my $notifylist;
                   14150:         if (@notified > 1) {
                   14151:             $notifylist = join(',',@notified);
                   14152:         } else {
                   14153:             $notifylist = $notified[0];
                   14154:         }
                   14155:         $cenv{'internal.notifylist'} = $notifylist;
                   14156:     }
                   14157:     if (@badclasses > 0) {
                   14158:         my %lt=&Apache::lonlocal::texthash(
                   14159:                 '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',
                   14160:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   14161:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   14162:         );
1.541     raeburn  14163:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   14164:                            ' ('.$lt{'adby'}.')';
                   14165:         if ($context eq 'auto') {
                   14166:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 14167:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  14168:             foreach my $item (@badclasses) {
                   14169:                 if ($context eq 'auto') {
                   14170:                     $outcome .= " - $item\n";
                   14171:                 } else {
                   14172:                     $outcome .= "<li>$item</li>\n";
                   14173:                 }
                   14174:             }
                   14175:             if ($context eq 'auto') {
                   14176:                 $outcome .= $linefeed;
                   14177:             } else {
1.566     albertel 14178:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14179:             }
                   14180:         } 
1.444     albertel 14181:     }
                   14182:     if ($args->{'no_end_date'}) {
                   14183:         $args->{'endaccess'} = 0;
                   14184:     }
                   14185:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14186:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14187:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14188:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14189:     if ($args->{'showphotos'}) {
                   14190:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14191:     }
                   14192:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14193:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14194:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14195:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14196:             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'); 
                   14197:             if ($context eq 'auto') {
                   14198:                 $outcome .= $krb_msg;
                   14199:             } else {
1.566     albertel 14200:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14201:             }
                   14202:             $outcome .= $linefeed;
1.444     albertel 14203:         }
                   14204:     }
                   14205:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14206:        if ($args->{'setpolicy'}) {
                   14207:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14208:        }
                   14209:        if ($args->{'setcontent'}) {
                   14210:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14211:        }
                   14212:     }
                   14213:     if ($args->{'reshome'}) {
                   14214: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14215: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14216:     }
                   14217: #
                   14218: # course has keyed access
                   14219: #
                   14220:     if ($args->{'setkeys'}) {
                   14221:        $cenv{'keyaccess'}='yes';
                   14222:     }
                   14223: # if specified, key authority is not course, but user
                   14224: # only active if keyaccess is yes
                   14225:     if ($args->{'keyauth'}) {
1.487     albertel 14226: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14227: 	$user = &LONCAPA::clean_username($user);
                   14228: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14229: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14230: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14231: 	}
                   14232:     }
                   14233: 
1.1075.2.59  raeburn  14234: #
                   14235: #  generate and store uniquecode (available to course requester), if course should have one.
                   14236: #
                   14237:     if ($args->{'uniquecode'}) {
                   14238:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   14239:         if ($code) {
                   14240:             $cenv{'internal.uniquecode'} = $code;
                   14241:             my %crsinfo =
                   14242:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   14243:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   14244:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   14245:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   14246:             }
                   14247:             if (ref($coderef)) {
                   14248:                 $$coderef = $code;
                   14249:             }
                   14250:         }
                   14251:     }
                   14252: 
1.444     albertel 14253:     if ($args->{'disresdis'}) {
                   14254:         $cenv{'pch.roles.denied'}='st';
                   14255:     }
                   14256:     if ($args->{'disablechat'}) {
                   14257:         $cenv{'plc.roles.denied'}='st';
                   14258:     }
                   14259: 
                   14260:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14261:     # course
                   14262:     $cenv{'course.helper.not.run'} = 1;
                   14263:     #
                   14264:     # Use new Randomseed
                   14265:     #
                   14266:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14267:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14268:     #
                   14269:     # The encryption code and receipt prefix for this course
                   14270:     #
                   14271:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14272:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14273:     #
                   14274:     # By default, use standard grading
                   14275:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14276: 
1.541     raeburn  14277:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14278:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14279: #
                   14280: # Open all assignments
                   14281: #
                   14282:     if ($args->{'openall'}) {
                   14283:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14284:        my %storecontent = ($storeunder         => time,
                   14285:                            $storeunder.'.type' => 'date_start');
                   14286:        
                   14287:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14288:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14289:    }
                   14290: #
                   14291: # Set first page
                   14292: #
                   14293:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14294: 	    || ($cloneid)) {
1.445     albertel 14295: 	use LONCAPA::map;
1.444     albertel 14296: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14297: 
                   14298: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14299:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14300: 
1.444     albertel 14301:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14302:         my $title; my $url;
                   14303:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14304: 	    $title=&mt('Syllabus');
1.444     albertel 14305:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14306:         } else {
1.963     raeburn  14307:             $title=&mt('Table of Contents');
1.444     albertel 14308:             $url='/adm/navmaps';
                   14309:         }
1.445     albertel 14310: 
                   14311:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14312: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14313: 
                   14314: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14315:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14316:     }
1.566     albertel 14317: 
                   14318:     return (1,$outcome);
1.444     albertel 14319: }
                   14320: 
1.1075.2.59  raeburn  14321: sub make_unique_code {
                   14322:     my ($cdom,$cnum) = @_;
                   14323:     # get lock on uniquecodes db
                   14324:     my $lockhash = {
                   14325:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   14326:                                                   ':'.$env{'user.domain'},
                   14327:                    };
                   14328:     my $tries = 0;
                   14329:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14330:     my ($code,$error);
                   14331: 
                   14332:     while (($gotlock ne 'ok') && ($tries<3)) {
                   14333:         $tries ++;
                   14334:         sleep 1;
                   14335:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14336:     }
                   14337:     if ($gotlock eq 'ok') {
                   14338:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   14339:         my $gotcode;
                   14340:         my $attempts = 0;
                   14341:         while ((!$gotcode) && ($attempts < 100)) {
                   14342:             $code = &generate_code();
                   14343:             if (!exists($currcodes{$code})) {
                   14344:                 $gotcode = 1;
                   14345:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   14346:                     $error = 'nostore';
                   14347:                 }
                   14348:             }
                   14349:             $attempts ++;
                   14350:         }
                   14351:         my @del_lock = ($cnum."\0".'uniquecodes');
                   14352:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   14353:     } else {
                   14354:         $error = 'nolock';
                   14355:     }
                   14356:     return ($code,$error);
                   14357: }
                   14358: 
                   14359: sub generate_code {
                   14360:     my $code;
                   14361:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   14362:     for (my $i=0; $i<6; $i++) {
                   14363:         my $lettnum = int (rand 2);
                   14364:         my $item = '';
                   14365:         if ($lettnum) {
                   14366:             $item = $letts[int( rand(18) )];
                   14367:         } else {
                   14368:             $item = 1+int( rand(8) );
                   14369:         }
                   14370:         $code .= $item;
                   14371:     }
                   14372:     return $code;
                   14373: }
                   14374: 
1.444     albertel 14375: ############################################################
                   14376: ############################################################
                   14377: 
1.953     droeschl 14378: #SD
                   14379: # only Community and Course, or anything else?
1.378     raeburn  14380: sub course_type {
                   14381:     my ($cid) = @_;
                   14382:     if (!defined($cid)) {
                   14383:         $cid = $env{'request.course.id'};
                   14384:     }
1.404     albertel 14385:     if (defined($env{'course.'.$cid.'.type'})) {
                   14386:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  14387:     } else {
                   14388:         return 'Course';
1.377     raeburn  14389:     }
                   14390: }
1.156     albertel 14391: 
1.406     raeburn  14392: sub group_term {
                   14393:     my $crstype = &course_type();
                   14394:     my %names = (
                   14395:                   'Course' => 'group',
1.865     raeburn  14396:                   'Community' => 'group',
1.406     raeburn  14397:                 );
                   14398:     return $names{$crstype};
                   14399: }
                   14400: 
1.902     raeburn  14401: sub course_types {
1.1075.2.59  raeburn  14402:     my @types = ('official','unofficial','community','textbook');
1.902     raeburn  14403:     my %typename = (
                   14404:                          official   => 'Official course',
                   14405:                          unofficial => 'Unofficial course',
                   14406:                          community  => 'Community',
1.1075.2.59  raeburn  14407:                          textbook   => 'Textbook course',
1.902     raeburn  14408:                    );
                   14409:     return (\@types,\%typename);
                   14410: }
                   14411: 
1.156     albertel 14412: sub icon {
                   14413:     my ($file)=@_;
1.505     albertel 14414:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 14415:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 14416:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 14417:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   14418: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   14419: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14420: 	            $curfext.".gif") {
                   14421: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14422: 		$curfext.".gif";
                   14423: 	}
                   14424:     }
1.249     albertel 14425:     return &lonhttpdurl($iconname);
1.154     albertel 14426: } 
1.84      albertel 14427: 
1.575     albertel 14428: sub lonhttpdurl {
1.692     www      14429: #
                   14430: # Had been used for "small fry" static images on separate port 8080.
                   14431: # Modify here if lightweight http functionality desired again.
                   14432: # Currently eliminated due to increasing firewall issues.
                   14433: #
1.575     albertel 14434:     my ($url)=@_;
1.692     www      14435:     return $url;
1.215     albertel 14436: }
                   14437: 
1.213     albertel 14438: sub connection_aborted {
                   14439:     my ($r)=@_;
                   14440:     $r->print(" ");$r->rflush();
                   14441:     my $c = $r->connection;
                   14442:     return $c->aborted();
                   14443: }
                   14444: 
1.221     foxr     14445: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     14446: #    strings as 'strings'.
                   14447: sub escape_single {
1.221     foxr     14448:     my ($input) = @_;
1.223     albertel 14449:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     14450:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   14451:     return $input;
                   14452: }
1.223     albertel 14453: 
1.222     foxr     14454: #  Same as escape_single, but escape's "'s  This 
                   14455: #  can be used for  "strings"
                   14456: sub escape_double {
                   14457:     my ($input) = @_;
                   14458:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   14459:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   14460:     return $input;
                   14461: }
1.223     albertel 14462:  
1.222     foxr     14463: #   Escapes the last element of a full URL.
                   14464: sub escape_url {
                   14465:     my ($url)   = @_;
1.238     raeburn  14466:     my @urlslices = split(/\//, $url,-1);
1.369     www      14467:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 14468:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     14469: }
1.462     albertel 14470: 
1.820     raeburn  14471: sub compare_arrays {
                   14472:     my ($arrayref1,$arrayref2) = @_;
                   14473:     my (@difference,%count);
                   14474:     @difference = ();
                   14475:     %count = ();
                   14476:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   14477:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   14478:         foreach my $element (keys(%count)) {
                   14479:             if ($count{$element} == 1) {
                   14480:                 push(@difference,$element);
                   14481:             }
                   14482:         }
                   14483:     }
                   14484:     return @difference;
                   14485: }
                   14486: 
1.817     bisitz   14487: # -------------------------------------------------------- Initialize user login
1.462     albertel 14488: sub init_user_environment {
1.463     albertel 14489:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 14490:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   14491: 
                   14492:     my $public=($username eq 'public' && $domain eq 'public');
                   14493: 
                   14494: # See if old ID present, if so, remove
                   14495: 
1.1062    raeburn  14496:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 14497:     my $now=time;
                   14498: 
                   14499:     if ($public) {
                   14500: 	my $max_public=100;
                   14501: 	my $oldest;
                   14502: 	my $oldest_time=0;
                   14503: 	for(my $next=1;$next<=$max_public;$next++) {
                   14504: 	    if (-e $lonids."/publicuser_$next.id") {
                   14505: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   14506: 		if ($mtime<$oldest_time || !$oldest_time) {
                   14507: 		    $oldest_time=$mtime;
                   14508: 		    $oldest=$next;
                   14509: 		}
                   14510: 	    } else {
                   14511: 		$cookie="publicuser_$next";
                   14512: 		last;
                   14513: 	    }
                   14514: 	}
                   14515: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   14516:     } else {
1.463     albertel 14517: 	# if this isn't a robot, kill any existing non-robot sessions
                   14518: 	if (!$args->{'robot'}) {
                   14519: 	    opendir(DIR,$lonids);
                   14520: 	    while ($filename=readdir(DIR)) {
                   14521: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   14522: 		    unlink($lonids.'/'.$filename);
                   14523: 		}
1.462     albertel 14524: 	    }
1.463     albertel 14525: 	    closedir(DIR);
1.462     albertel 14526: 	}
                   14527: # Give them a new cookie
1.463     albertel 14528: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      14529: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 14530: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 14531:     
                   14532: # Initialize roles
                   14533: 
1.1062    raeburn  14534: 	($userroles,$firstaccenv,$timerintenv) = 
                   14535:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 14536:     }
                   14537: # ------------------------------------ Check browser type and MathML capability
                   14538: 
1.1075.2.77  raeburn  14539:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   14540:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 14541: 
                   14542: # ------------------------------------------------------------- Get environment
                   14543: 
                   14544:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   14545:     my ($tmp) = keys(%userenv);
                   14546:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   14547:     } else {
                   14548: 	undef(%userenv);
                   14549:     }
                   14550:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   14551: 	$form->{'interface'}=$userenv{'interface'};
                   14552:     }
                   14553:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   14554: 
                   14555: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   14556:     foreach my $option ('interface','localpath','localres') {
                   14557:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 14558:     }
                   14559: # --------------------------------------------------------- Write first profile
                   14560: 
                   14561:     {
                   14562: 	my %initial_env = 
                   14563: 	    ("user.name"          => $username,
                   14564: 	     "user.domain"        => $domain,
                   14565: 	     "user.home"          => $authhost,
                   14566: 	     "browser.type"       => $clientbrowser,
                   14567: 	     "browser.version"    => $clientversion,
                   14568: 	     "browser.mathml"     => $clientmathml,
                   14569: 	     "browser.unicode"    => $clientunicode,
                   14570: 	     "browser.os"         => $clientos,
1.1075.2.42  raeburn  14571:              "browser.mobile"     => $clientmobile,
                   14572:              "browser.info"       => $clientinfo,
1.1075.2.77  raeburn  14573:              "browser.osversion"  => $clientosversion,
1.462     albertel 14574: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   14575: 	     "request.course.fn"  => '',
                   14576: 	     "request.course.uri" => '',
                   14577: 	     "request.course.sec" => '',
                   14578: 	     "request.role"       => 'cm',
                   14579: 	     "request.role.adv"   => $env{'user.adv'},
                   14580: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   14581: 
                   14582:         if ($form->{'localpath'}) {
                   14583: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   14584: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   14585:         }
                   14586: 	
                   14587: 	if ($form->{'interface'}) {
                   14588: 	    $form->{'interface'}=~s/\W//gs;
                   14589: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   14590: 	    $env{'browser.interface'}=$form->{'interface'};
                   14591: 	}
                   14592: 
1.1075.2.54  raeburn  14593:         if ($form->{'iptoken'}) {
                   14594:             my $lonhost = $r->dir_config('lonHostID');
                   14595:             $initial_env{"user.noloadbalance"} = $lonhost;
                   14596:             $env{'user.noloadbalance'} = $lonhost;
                   14597:         }
                   14598: 
1.981     raeburn  14599:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  14600:         my %domdef;
                   14601:         unless ($domain eq 'public') {
                   14602:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   14603:         }
1.980     raeburn  14604: 
1.1075.2.7  raeburn  14605:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  14606:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  14607:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   14608:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  14609:         }
                   14610: 
1.1075.2.59  raeburn  14611:         foreach my $crstype ('official','unofficial','community','textbook') {
1.765     raeburn  14612:             $userenv{'canrequest.'.$crstype} =
                   14613:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  14614:                                                   'reload','requestcourses',
                   14615:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  14616:         }
                   14617: 
1.1075.2.14  raeburn  14618:         $userenv{'canrequest.author'} =
                   14619:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   14620:                                         'reload','requestauthor',
                   14621:                                         \%userenv,\%domdef,\%is_adv);
                   14622:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   14623:                                              $domain,$username);
                   14624:         my $reqstatus = $reqauthor{'author_status'};
                   14625:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   14626:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   14627:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   14628:                                                   $reqauthor{'author'}{'timestamp'};
                   14629:             }
                   14630:         }
                   14631: 
1.462     albertel 14632: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  14633: 
1.462     albertel 14634: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   14635: 		 &GDBM_WRCREAT(),0640)) {
                   14636: 	    &_add_to_env(\%disk_env,\%initial_env);
                   14637: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   14638: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  14639:             if (ref($firstaccenv) eq 'HASH') {
                   14640:                 &_add_to_env(\%disk_env,$firstaccenv);
                   14641:             }
                   14642:             if (ref($timerintenv) eq 'HASH') {
                   14643:                 &_add_to_env(\%disk_env,$timerintenv);
                   14644:             }
1.463     albertel 14645: 	    if (ref($args->{'extra_env'})) {
                   14646: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   14647: 	    }
1.462     albertel 14648: 	    untie(%disk_env);
                   14649: 	} else {
1.705     tempelho 14650: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   14651: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 14652: 	    return 'error: '.$!;
                   14653: 	}
                   14654:     }
                   14655:     $env{'request.role'}='cm';
                   14656:     $env{'request.role.adv'}=$env{'user.adv'};
                   14657:     $env{'browser.type'}=$clientbrowser;
                   14658: 
                   14659:     return $cookie;
                   14660: 
                   14661: }
                   14662: 
                   14663: sub _add_to_env {
                   14664:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14665:     if (ref($env_data) eq 'HASH') {
                   14666:         while (my ($key,$value) = each(%$env_data)) {
                   14667: 	    $idf->{$prefix.$key} = $value;
                   14668: 	    $env{$prefix.$key}   = $value;
                   14669:         }
1.462     albertel 14670:     }
                   14671: }
                   14672: 
1.685     tempelho 14673: # --- Get the symbolic name of a problem and the url
                   14674: sub get_symb {
                   14675:     my ($request,$silent) = @_;
1.726     raeburn  14676:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14677:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14678:     if ($symb eq '') {
                   14679:         if (!$silent) {
1.1071    raeburn  14680:             if (ref($request)) { 
                   14681:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14682:             }
1.685     tempelho 14683:             return ();
                   14684:         }
                   14685:     }
                   14686:     &Apache::lonenc::check_decrypt(\$symb);
                   14687:     return ($symb);
                   14688: }
                   14689: 
                   14690: # --------------------------------------------------------------Get annotation
                   14691: 
                   14692: sub get_annotation {
                   14693:     my ($symb,$enc) = @_;
                   14694: 
                   14695:     my $key = $symb;
                   14696:     if (!$enc) {
                   14697:         $key =
                   14698:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14699:     }
                   14700:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14701:     return $annotation{$key};
                   14702: }
                   14703: 
                   14704: sub clean_symb {
1.731     raeburn  14705:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14706: 
                   14707:     &Apache::lonenc::check_decrypt(\$symb);
                   14708:     my $enc = $env{'request.enc'};
1.731     raeburn  14709:     if ($delete_enc) {
1.730     raeburn  14710:         delete($env{'request.enc'});
                   14711:     }
1.685     tempelho 14712: 
                   14713:     return ($symb,$enc);
                   14714: }
1.462     albertel 14715: 
1.1075.2.69  raeburn  14716: ############################################################
                   14717: ############################################################
                   14718: 
                   14719: =pod
                   14720: 
                   14721: =head1 Routines for building display used to search for courses
                   14722: 
                   14723: 
                   14724: =over 4
                   14725: 
                   14726: =item * &build_filters()
                   14727: 
                   14728: Create markup for a table used to set filters to use when selecting
                   14729: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   14730: and quotacheck.pl
                   14731: 
                   14732: 
                   14733: Inputs:
                   14734: 
                   14735: filterlist - anonymous array of fields to include as potential filters
                   14736: 
                   14737: crstype - course type
                   14738: 
                   14739: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   14740:               to pop-open a course selector (will contain "extra element").
                   14741: 
                   14742: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   14743: 
                   14744: filter - anonymous hash of criteria and their values
                   14745: 
                   14746: action - form action
                   14747: 
                   14748: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   14749: 
                   14750: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
                   14751: 
                   14752: cloneruname - username of owner of new course who wants to clone
                   14753: 
                   14754: clonerudom - domain of owner of new course who wants to clone
                   14755: 
                   14756: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
                   14757: 
                   14758: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   14759: 
                   14760: codedom - domain
                   14761: 
                   14762: formname - value of form element named "form".
                   14763: 
                   14764: fixeddom - domain, if fixed.
                   14765: 
                   14766: prevphase - value to assign to form element named "phase" when going back to the previous screen
                   14767: 
                   14768: cnameelement - name of form element in form on opener page which will receive title of selected course
                   14769: 
                   14770: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   14771: 
                   14772: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   14773: 
                   14774: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   14775: 
                   14776: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   14777: 
                   14778: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   14779: 
                   14780: 
                   14781: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   14782: 
                   14783: 
                   14784: Side Effects: None
                   14785: 
                   14786: =cut
                   14787: 
                   14788: # ---------------------------------------------- search for courses based on last activity etc.
                   14789: 
                   14790: sub build_filters {
                   14791:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   14792:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   14793:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   14794:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   14795:         $clonetext,$clonewarning) = @_;
                   14796:     my ($list,$jscript);
                   14797:     my $onchange = 'javascript:updateFilters(this)';
                   14798:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   14799:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   14800:         $typeselectform,$instcodetitle);
                   14801:     if ($formname eq '') {
                   14802:         $formname = $caller;
                   14803:     }
                   14804:     foreach my $item (@{$filterlist}) {
                   14805:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   14806:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   14807:             if ($item eq 'domainfilter') {
                   14808:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   14809:             } elsif ($item eq 'coursefilter') {
                   14810:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   14811:             } elsif ($item eq 'ownerfilter') {
                   14812:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14813:             } elsif ($item eq 'ownerdomfilter') {
                   14814:                 $filter->{'ownerdomfilter'} =
                   14815:                     &LONCAPA::clean_domain($filter->{$item});
                   14816:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   14817:                                                        'ownerdomfilter',1);
                   14818:             } elsif ($item eq 'personfilter') {
                   14819:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14820:             } elsif ($item eq 'persondomfilter') {
                   14821:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   14822:                                                         'persondomfilter',1);
                   14823:             } else {
                   14824:                 $filter->{$item} =~ s/\W//g;
                   14825:             }
                   14826:             if (!$filter->{$item}) {
                   14827:                 $filter->{$item} = '';
                   14828:             }
                   14829:         }
                   14830:         if ($item eq 'domainfilter') {
                   14831:             my $allow_blank = 1;
                   14832:             if ($formname eq 'portform') {
                   14833:                 $allow_blank=0;
                   14834:             } elsif ($formname eq 'studentform') {
                   14835:                 $allow_blank=0;
                   14836:             }
                   14837:             if ($fixeddom) {
                   14838:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   14839:                                     ' value="'.$codedom.'" />'.
                   14840:                                     &Apache::lonnet::domain($codedom,'description');
                   14841:             } else {
                   14842:                 $domainselectform = &select_dom_form($filter->{$item},
                   14843:                                                      'domainfilter',
                   14844:                                                       $allow_blank,'',$onchange);
                   14845:             }
                   14846:         } else {
                   14847:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   14848:         }
                   14849:     }
                   14850: 
                   14851:     # last course activity filter and selection
                   14852:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   14853: 
                   14854:     # course created filter and selection
                   14855:     if (exists($filter->{'createdfilter'})) {
                   14856:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   14857:     }
                   14858: 
                   14859:     my %lt = &Apache::lonlocal::texthash(
                   14860:                 'cac' => "$crstype Activity",
                   14861:                 'ccr' => "$crstype Created",
                   14862:                 'cde' => "$crstype Title",
                   14863:                 'cdo' => "$crstype Domain",
                   14864:                 'ins' => 'Institutional Code',
                   14865:                 'inc' => 'Institutional Categorization',
                   14866:                 'cow' => "$crstype Owner/Co-owner",
                   14867:                 'cop' => "$crstype Personnel Includes",
                   14868:                 'cog' => 'Type',
                   14869:              );
                   14870: 
                   14871:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   14872:         my $typeval = 'Course';
                   14873:         if ($crstype eq 'Community') {
                   14874:             $typeval = 'Community';
                   14875:         }
                   14876:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   14877:     } else {
                   14878:         $typeselectform =  '<select name="type" size="1"';
                   14879:         if ($onchange) {
                   14880:             $typeselectform .= ' onchange="'.$onchange.'"';
                   14881:         }
                   14882:         $typeselectform .= '>'."\n";
                   14883:         foreach my $posstype ('Course','Community') {
                   14884:             $typeselectform.='<option value="'.$posstype.'"'.
                   14885:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
                   14886:         }
                   14887:         $typeselectform.="</select>";
                   14888:     }
                   14889: 
                   14890:     my ($cloneableonlyform,$cloneabletitle);
                   14891:     if (exists($filter->{'cloneableonly'})) {
                   14892:         my $cloneableon = '';
                   14893:         my $cloneableoff = ' checked="checked"';
                   14894:         if ($filter->{'cloneableonly'}) {
                   14895:             $cloneableon = $cloneableoff;
                   14896:             $cloneableoff = '';
                   14897:         }
                   14898:         $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>';
                   14899:         if ($formname eq 'ccrs') {
1.1075.2.71  raeburn  14900:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69  raeburn  14901:         } else {
                   14902:             $cloneabletitle = &mt('Cloneable by you');
                   14903:         }
                   14904:     }
                   14905:     my $officialjs;
                   14906:     if ($crstype eq 'Course') {
                   14907:         if (exists($filter->{'instcodefilter'})) {
                   14908: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   14909: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   14910:             if ($codedom) {
                   14911:                 $officialjs = 1;
                   14912:                 ($instcodeform,$jscript,$$numtitlesref) =
                   14913:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   14914:                                                                   $officialjs,$codetitlesref);
                   14915:                 if ($jscript) {
                   14916:                     $jscript = '<script type="text/javascript">'."\n".
                   14917:                                '// <![CDATA['."\n".
                   14918:                                $jscript."\n".
                   14919:                                '// ]]>'."\n".
                   14920:                                '</script>'."\n";
                   14921:                 }
                   14922:             }
                   14923:             if ($instcodeform eq '') {
                   14924:                 $instcodeform =
                   14925:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   14926:                     $list->{'instcodefilter'}.'" />';
                   14927:                 $instcodetitle = $lt{'ins'};
                   14928:             } else {
                   14929:                 $instcodetitle = $lt{'inc'};
                   14930:             }
                   14931:             if ($fixeddom) {
                   14932:                 $instcodetitle .= '<br />('.$codedom.')';
                   14933:             }
                   14934:         }
                   14935:     }
                   14936:     my $output = qq|
                   14937: <form method="post" name="filterpicker" action="$action">
                   14938: <input type="hidden" name="form" value="$formname" />
                   14939: |;
                   14940:     if ($formname eq 'modifycourse') {
                   14941:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   14942:                    '<input type="hidden" name="prevphase" value="'.
                   14943:                    $prevphase.'" />'."\n";
                   14944:     } elsif ($formname ne 'quotacheck') {
                   14945:         my $name_input;
                   14946:         if ($cnameelement ne '') {
                   14947:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   14948:                           $cnameelement.'" />';
                   14949:         }
                   14950:         $output .= qq|
                   14951: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   14952: <input type="hidden" name="cdomelement" value="$cdomelement" />
                   14953: $name_input
                   14954: $roleelement
                   14955: $multelement
                   14956: $typeelement
                   14957: |;
                   14958:         if ($formname eq 'portform') {
                   14959:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   14960:         }
                   14961:     }
                   14962:     if ($fixeddom) {
                   14963:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   14964:     }
                   14965:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   14966:     if ($sincefilterform) {
                   14967:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   14968:                   .$sincefilterform
                   14969:                   .&Apache::lonhtmlcommon::row_closure();
                   14970:     }
                   14971:     if ($createdfilterform) {
                   14972:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   14973:                   .$createdfilterform
                   14974:                   .&Apache::lonhtmlcommon::row_closure();
                   14975:     }
                   14976:     if ($domainselectform) {
                   14977:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   14978:                   .$domainselectform
                   14979:                   .&Apache::lonhtmlcommon::row_closure();
                   14980:     }
                   14981:     if ($typeselectform) {
                   14982:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   14983:             $output .= $typeselectform;
                   14984:         } else {
                   14985:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   14986:                       .$typeselectform
                   14987:                       .&Apache::lonhtmlcommon::row_closure();
                   14988:         }
                   14989:     }
                   14990:     if ($instcodeform) {
                   14991:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   14992:                   .$instcodeform
                   14993:                   .&Apache::lonhtmlcommon::row_closure();
                   14994:     }
                   14995:     if (exists($filter->{'ownerfilter'})) {
                   14996:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   14997:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   14998:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   14999:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15000:                    $ownerdomselectform.'</td></tr></table>'.
                   15001:                    &Apache::lonhtmlcommon::row_closure();
                   15002:     }
                   15003:     if (exists($filter->{'personfilter'})) {
                   15004:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   15005:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15006:                    '<input type="text" name="personfilter" size="20" value="'.
                   15007:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15008:                    $persondomselectform.'</td></tr></table>'.
                   15009:                    &Apache::lonhtmlcommon::row_closure();
                   15010:     }
                   15011:     if (exists($filter->{'coursefilter'})) {
                   15012:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   15013:                   .'<input type="text" name="coursefilter" size="25" value="'
                   15014:                   .$list->{'coursefilter'}.'" />'
                   15015:                   .&Apache::lonhtmlcommon::row_closure();
                   15016:     }
                   15017:     if ($cloneableonlyform) {
                   15018:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   15019:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   15020:     }
                   15021:     if (exists($filter->{'descriptfilter'})) {
                   15022:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   15023:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   15024:                   .$list->{'descriptfilter'}.'" />'
                   15025:                   .&Apache::lonhtmlcommon::row_closure(1);
                   15026:     }
                   15027:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   15028:                '<input type="hidden" name="updater" value="" />'."\n".
                   15029:                '<input type="submit" name="gosearch" value="'.
                   15030:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   15031:     return $jscript.$clonewarning.$output;
                   15032: }
                   15033: 
                   15034: =pod
                   15035: 
                   15036: =item * &timebased_select_form()
                   15037: 
                   15038: Create markup for a dropdown list used to select a time-based
                   15039: filter e.g., Course Activity, Course Created, when searching for courses
                   15040: or communities
                   15041: 
                   15042: Inputs:
                   15043: 
                   15044: item - name of form element (sincefilter or createdfilter)
                   15045: 
                   15046: filter - anonymous hash of criteria and their values
                   15047: 
                   15048: Returns: HTML for a select box contained a blank, then six time selections,
                   15049:          with value set in incoming form variables currently selected.
                   15050: 
                   15051: Side Effects: None
                   15052: 
                   15053: =cut
                   15054: 
                   15055: sub timebased_select_form {
                   15056:     my ($item,$filter) = @_;
                   15057:     if (ref($filter) eq 'HASH') {
                   15058:         $filter->{$item} =~ s/[^\d-]//g;
                   15059:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   15060:         return &select_form(
                   15061:                             $filter->{$item},
                   15062:                             $item,
                   15063:                             {      '-1' => '',
                   15064:                                 '86400' => &mt('today'),
                   15065:                                '604800' => &mt('last week'),
                   15066:                               '2592000' => &mt('last month'),
                   15067:                               '7776000' => &mt('last three months'),
                   15068:                              '15552000' => &mt('last six months'),
                   15069:                              '31104000' => &mt('last year'),
                   15070:                     'select_form_order' =>
                   15071:                            ['-1','86400','604800','2592000','7776000',
                   15072:                             '15552000','31104000']});
                   15073:     }
                   15074: }
                   15075: 
                   15076: =pod
                   15077: 
                   15078: =item * &js_changer()
                   15079: 
                   15080: Create script tag containing Javascript used to submit course search form
                   15081: when course type or domain is changed, and also to hide 'Searching ...' on
                   15082: page load completion for page showing search result.
                   15083: 
                   15084: Inputs: None
                   15085: 
                   15086: Returns: markup containing updateFilters() and hideSearching() javascript functions.
                   15087: 
                   15088: Side Effects: None
                   15089: 
                   15090: =cut
                   15091: 
                   15092: sub js_changer {
                   15093:     return <<ENDJS;
                   15094: <script type="text/javascript">
                   15095: // <![CDATA[
                   15096: function updateFilters(caller) {
                   15097:     if (typeof(caller) != "undefined") {
                   15098:         document.filterpicker.updater.value = caller.name;
                   15099:     }
                   15100:     document.filterpicker.submit();
                   15101: }
                   15102: 
                   15103: function hideSearching() {
                   15104:     if (document.getElementById('searching')) {
                   15105:         document.getElementById('searching').style.display = 'none';
                   15106:     }
                   15107:     return;
                   15108: }
                   15109: 
                   15110: // ]]>
                   15111: </script>
                   15112: 
                   15113: ENDJS
                   15114: }
                   15115: 
                   15116: =pod
                   15117: 
                   15118: =item * &search_courses()
                   15119: 
                   15120: Process selected filters form course search form and pass to lonnet::courseiddump
                   15121: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   15122: 
                   15123: Inputs:
                   15124: 
                   15125: dom - domain being searched
                   15126: 
                   15127: type - course type ('Course' or 'Community' or '.' if any).
                   15128: 
                   15129: filter - anonymous hash of criteria and their values
                   15130: 
                   15131: numtitles - for institutional codes - number of categories
                   15132: 
                   15133: cloneruname - optional username of new course owner
                   15134: 
                   15135: clonerudom - optional domain of new course owner
                   15136: 
                   15137: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
                   15138:             (used when DC is using course creation form)
                   15139: 
                   15140: codetitles - reference to array of titles of components in institutional codes (official courses).
                   15141: 
                   15142: 
                   15143: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   15144: 
                   15145: 
                   15146: Side Effects: None
                   15147: 
                   15148: =cut
                   15149: 
                   15150: 
                   15151: sub search_courses {
                   15152:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
                   15153:     my (%courses,%showcourses,$cloner);
                   15154:     if (($filter->{'ownerfilter'} ne '') ||
                   15155:         ($filter->{'ownerdomfilter'} ne '')) {
                   15156:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   15157:                                        $filter->{'ownerdomfilter'};
                   15158:     }
                   15159:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   15160:         if (!$filter->{$item}) {
                   15161:             $filter->{$item}='.';
                   15162:         }
                   15163:     }
                   15164:     my $now = time;
                   15165:     my $timefilter =
                   15166:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   15167:     my ($createdbefore,$createdafter);
                   15168:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   15169:         $createdbefore = $now;
                   15170:         $createdafter = $now-$filter->{'createdfilter'};
                   15171:     }
                   15172:     my ($instcodefilter,$regexpok);
                   15173:     if ($numtitles) {
                   15174:         if ($env{'form.official'} eq 'on') {
                   15175:             $instcodefilter =
                   15176:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15177:             $regexpok = 1;
                   15178:         } elsif ($env{'form.official'} eq 'off') {
                   15179:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15180:             unless ($instcodefilter eq '') {
                   15181:                 $regexpok = -1;
                   15182:             }
                   15183:         }
                   15184:     } else {
                   15185:         $instcodefilter = $filter->{'instcodefilter'};
                   15186:     }
                   15187:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   15188:     if ($type eq '') { $type = '.'; }
                   15189: 
                   15190:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   15191:         $cloner = $cloneruname.':'.$clonerudom;
                   15192:     }
                   15193:     %courses = &Apache::lonnet::courseiddump($dom,
                   15194:                                              $filter->{'descriptfilter'},
                   15195:                                              $timefilter,
                   15196:                                              $instcodefilter,
                   15197:                                              $filter->{'combownerfilter'},
                   15198:                                              $filter->{'coursefilter'},
                   15199:                                              undef,undef,$type,$regexpok,undef,undef,
                   15200:                                              undef,undef,$cloner,$env{'form.cc_clone'},
                   15201:                                              $filter->{'cloneableonly'},
                   15202:                                              $createdbefore,$createdafter,undef,
                   15203:                                              $domcloner);
                   15204:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   15205:         my $ccrole;
                   15206:         if ($type eq 'Community') {
                   15207:             $ccrole = 'co';
                   15208:         } else {
                   15209:             $ccrole = 'cc';
                   15210:         }
                   15211:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   15212:                                                      $filter->{'persondomfilter'},
                   15213:                                                      'userroles',undef,
                   15214:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   15215:                                                      $dom);
                   15216:         foreach my $role (keys(%rolehash)) {
                   15217:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   15218:             my $cid = $cdom.'_'.$cnum;
                   15219:             if (exists($courses{$cid})) {
                   15220:                 if (ref($courses{$cid}) eq 'HASH') {
                   15221:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   15222:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                   15223:                             push (@{$courses{$cid}{roles}},$courserole);
                   15224:                         }
                   15225:                     } else {
                   15226:                         $courses{$cid}{roles} = [$courserole];
                   15227:                     }
                   15228:                     $showcourses{$cid} = $courses{$cid};
                   15229:                 }
                   15230:             }
                   15231:         }
                   15232:         %courses = %showcourses;
                   15233:     }
                   15234:     return %courses;
                   15235: }
                   15236: 
                   15237: 
                   15238: =pod
                   15239: 
                   15240: =back
                   15241: 
                   15242: =cut
                   15243: 
                   15244: 
1.1075.2.11  raeburn  15245: sub update_content_constraints {
                   15246:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15247:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   15248:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   15249:     my %checkresponsetypes;
                   15250:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   15251:         my ($item,$name,$value) = split(/:/,$key);
                   15252:         if ($item eq 'resourcetag') {
                   15253:             if ($name eq 'responsetype') {
                   15254:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   15255:             }
                   15256:         }
                   15257:     }
                   15258:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15259:     if (defined($navmap)) {
                   15260:         my %allresponses;
                   15261:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   15262:             my %responses = $res->responseTypes();
                   15263:             foreach my $key (keys(%responses)) {
                   15264:                 next unless(exists($checkresponsetypes{$key}));
                   15265:                 $allresponses{$key} += $responses{$key};
                   15266:             }
                   15267:         }
                   15268:         foreach my $key (keys(%allresponses)) {
                   15269:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   15270:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   15271:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   15272:             }
                   15273:         }
                   15274:         undef($navmap);
                   15275:     }
                   15276:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   15277:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   15278:     }
                   15279:     return;
                   15280: }
                   15281: 
1.1075.2.27  raeburn  15282: sub allmaps_incourse {
                   15283:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15284:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   15285:         $cid = $env{'request.course.id'};
                   15286:         $cdom = $env{'course.'.$cid.'.domain'};
                   15287:         $cnum = $env{'course.'.$cid.'.num'};
                   15288:         $chome = $env{'course.'.$cid.'.home'};
                   15289:     }
                   15290:     my %allmaps = ();
                   15291:     my $lastchange =
                   15292:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   15293:     if ($lastchange > $env{'request.course.tied'}) {
                   15294:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   15295:         unless ($ferr) {
                   15296:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   15297:         }
                   15298:     }
                   15299:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15300:     if (defined($navmap)) {
                   15301:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   15302:             $allmaps{$res->src()} = 1;
                   15303:         }
                   15304:     }
                   15305:     return \%allmaps;
                   15306: }
                   15307: 
1.1075.2.11  raeburn  15308: sub parse_supplemental_title {
                   15309:     my ($title) = @_;
                   15310: 
                   15311:     my ($foldertitle,$renametitle);
                   15312:     if ($title =~ /&amp;&amp;&amp;/) {
                   15313:         $title = &HTML::Entites::decode($title);
                   15314:     }
                   15315:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   15316:         $renametitle=$4;
                   15317:         my ($time,$uname,$udom) = ($1,$2,$3);
                   15318:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   15319:         my $name =  &plainname($uname,$udom);
                   15320:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   15321:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   15322:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   15323:             $name.': <br />'.$foldertitle;
                   15324:     }
                   15325:     if (wantarray) {
                   15326:         return ($title,$foldertitle,$renametitle);
                   15327:     }
                   15328:     return $title;
                   15329: }
                   15330: 
1.1075.2.43  raeburn  15331: sub recurse_supplemental {
                   15332:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   15333:     if ($suppmap) {
                   15334:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   15335:         if ($fatal) {
                   15336:             $errors ++;
                   15337:         } else {
                   15338:             if ($#LONCAPA::map::resources > 0) {
                   15339:                 foreach my $res (@LONCAPA::map::resources) {
                   15340:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   15341:                     if (($src ne '') && ($status eq 'res')) {
1.1075.2.46  raeburn  15342:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   15343:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43  raeburn  15344:                         } else {
                   15345:                             $numfiles ++;
                   15346:                         }
                   15347:                     }
                   15348:                 }
                   15349:             }
                   15350:         }
                   15351:     }
                   15352:     return ($numfiles,$errors);
                   15353: }
                   15354: 
1.1075.2.18  raeburn  15355: sub symb_to_docspath {
                   15356:     my ($symb) = @_;
                   15357:     return unless ($symb);
                   15358:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   15359:     if ($resurl=~/\.(sequence|page)$/) {
                   15360:         $mapurl=$resurl;
                   15361:     } elsif ($resurl eq 'adm/navmaps') {
                   15362:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   15363:     }
                   15364:     my $mapresobj;
                   15365:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15366:     if (ref($navmap)) {
                   15367:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   15368:     }
                   15369:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   15370:     my $type=$2;
                   15371:     my $path;
                   15372:     if (ref($mapresobj)) {
                   15373:         my $pcslist = $mapresobj->map_hierarchy();
                   15374:         if ($pcslist ne '') {
                   15375:             foreach my $pc (split(/,/,$pcslist)) {
                   15376:                 next if ($pc <= 1);
                   15377:                 my $res = $navmap->getByMapPc($pc);
                   15378:                 if (ref($res)) {
                   15379:                     my $thisurl = $res->src();
                   15380:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   15381:                     my $thistitle = $res->title();
                   15382:                     $path .= '&'.
                   15383:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46  raeburn  15384:                              &escape($thistitle).
1.1075.2.18  raeburn  15385:                              ':'.$res->randompick().
                   15386:                              ':'.$res->randomout().
                   15387:                              ':'.$res->encrypted().
                   15388:                              ':'.$res->randomorder().
                   15389:                              ':'.$res->is_page();
                   15390:                 }
                   15391:             }
                   15392:         }
                   15393:         $path =~ s/^\&//;
                   15394:         my $maptitle = $mapresobj->title();
                   15395:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15396:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15397:         }
                   15398:         $path .= (($path ne '')? '&' : '').
                   15399:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15400:                  &escape($maptitle).
1.1075.2.18  raeburn  15401:                  ':'.$mapresobj->randompick().
                   15402:                  ':'.$mapresobj->randomout().
                   15403:                  ':'.$mapresobj->encrypted().
                   15404:                  ':'.$mapresobj->randomorder().
                   15405:                  ':'.$mapresobj->is_page();
                   15406:     } else {
                   15407:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   15408:         my $ispage = (($type eq 'page')? 1 : '');
                   15409:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15410:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15411:         }
                   15412:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15413:                 &escape($maptitle).':::::'.$ispage;
1.1075.2.18  raeburn  15414:     }
                   15415:     unless ($mapurl eq 'default') {
                   15416:         $path = 'default&'.
1.1075.2.46  raeburn  15417:                 &escape('Main Content').
1.1075.2.18  raeburn  15418:                 ':::::&'.$path;
                   15419:     }
                   15420:     return $path;
                   15421: }
                   15422: 
1.1075.2.14  raeburn  15423: sub captcha_display {
                   15424:     my ($context,$lonhost) = @_;
                   15425:     my ($output,$error);
                   15426:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   15427:     if ($captcha eq 'original') {
                   15428:         $output = &create_captcha();
                   15429:         unless ($output) {
                   15430:             $error = 'captcha';
                   15431:         }
                   15432:     } elsif ($captcha eq 'recaptcha') {
                   15433:         $output = &create_recaptcha($pubkey);
                   15434:         unless ($output) {
                   15435:             $error = 'recaptcha';
                   15436:         }
                   15437:     }
1.1075.2.66  raeburn  15438:     return ($output,$error,$captcha);
1.1075.2.14  raeburn  15439: }
                   15440: 
                   15441: sub captcha_response {
                   15442:     my ($context,$lonhost) = @_;
                   15443:     my ($captcha_chk,$captcha_error);
                   15444:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   15445:     if ($captcha eq 'original') {
                   15446:         ($captcha_chk,$captcha_error) = &check_captcha();
                   15447:     } elsif ($captcha eq 'recaptcha') {
                   15448:         $captcha_chk = &check_recaptcha($privkey);
                   15449:     } else {
                   15450:         $captcha_chk = 1;
                   15451:     }
                   15452:     return ($captcha_chk,$captcha_error);
                   15453: }
                   15454: 
                   15455: sub get_captcha_config {
                   15456:     my ($context,$lonhost) = @_;
                   15457:     my ($captcha,$pubkey,$privkey,$hashtocheck);
                   15458:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   15459:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   15460:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   15461:     if ($context eq 'usercreation') {
                   15462:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   15463:         if (ref($domconfig{$context}) eq 'HASH') {
                   15464:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   15465:             if (ref($hashtocheck) eq 'HASH') {
                   15466:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   15467:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   15468:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   15469:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   15470:                     }
                   15471:                     if ($privkey && $pubkey) {
                   15472:                         $captcha = 'recaptcha';
                   15473:                     } else {
                   15474:                         $captcha = 'original';
                   15475:                     }
                   15476:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   15477:                     $captcha = 'original';
                   15478:                 }
                   15479:             }
                   15480:         } else {
                   15481:             $captcha = 'captcha';
                   15482:         }
                   15483:     } elsif ($context eq 'login') {
                   15484:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   15485:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   15486:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   15487:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   15488:             if ($privkey && $pubkey) {
                   15489:                 $captcha = 'recaptcha';
                   15490:             } else {
                   15491:                 $captcha = 'original';
                   15492:             }
                   15493:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   15494:             $captcha = 'original';
                   15495:         }
                   15496:     }
                   15497:     return ($captcha,$pubkey,$privkey);
                   15498: }
                   15499: 
                   15500: sub create_captcha {
                   15501:     my %captcha_params = &captcha_settings();
                   15502:     my ($output,$maxtries,$tries) = ('',10,0);
                   15503:     while ($tries < $maxtries) {
                   15504:         $tries ++;
                   15505:         my $captcha = Authen::Captcha->new (
                   15506:                                            output_folder => $captcha_params{'output_dir'},
                   15507:                                            data_folder   => $captcha_params{'db_dir'},
                   15508:                                           );
                   15509:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   15510: 
                   15511:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   15512:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   15513:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1075.2.66  raeburn  15514:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   15515:                       '<br />'.
                   15516:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14  raeburn  15517:             last;
                   15518:         }
                   15519:     }
                   15520:     return $output;
                   15521: }
                   15522: 
                   15523: sub captcha_settings {
                   15524:     my %captcha_params = (
                   15525:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   15526:                            www_output_dir => "/captchaspool",
                   15527:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   15528:                            numchars       => '5',
                   15529:                          );
                   15530:     return %captcha_params;
                   15531: }
                   15532: 
                   15533: sub check_captcha {
                   15534:     my ($captcha_chk,$captcha_error);
                   15535:     my $code = $env{'form.code'};
                   15536:     my $md5sum = $env{'form.crypt'};
                   15537:     my %captcha_params = &captcha_settings();
                   15538:     my $captcha = Authen::Captcha->new(
                   15539:                       output_folder => $captcha_params{'output_dir'},
                   15540:                       data_folder   => $captcha_params{'db_dir'},
                   15541:                   );
1.1075.2.26  raeburn  15542:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14  raeburn  15543:     my %captcha_hash = (
                   15544:                         0       => 'Code not checked (file error)',
                   15545:                        -1      => 'Failed: code expired',
                   15546:                        -2      => 'Failed: invalid code (not in database)',
                   15547:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   15548:     );
                   15549:     if ($captcha_chk != 1) {
                   15550:         $captcha_error = $captcha_hash{$captcha_chk}
                   15551:     }
                   15552:     return ($captcha_chk,$captcha_error);
                   15553: }
                   15554: 
                   15555: sub create_recaptcha {
                   15556:     my ($pubkey) = @_;
1.1075.2.51  raeburn  15557:     my $use_ssl;
                   15558:     if ($ENV{'SERVER_PORT'} == 443) {
                   15559:         $use_ssl = 1;
                   15560:     }
1.1075.2.14  raeburn  15561:     my $captcha = Captcha::reCAPTCHA->new;
                   15562:     return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51  raeburn  15563:            $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.14  raeburn  15564:            &mt('If either word is hard to read, [_1] will replace them.',
1.1075.2.39  raeburn  15565:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14  raeburn  15566:            '<br /><br />';
                   15567: }
                   15568: 
                   15569: sub check_recaptcha {
                   15570:     my ($privkey) = @_;
                   15571:     my $captcha_chk;
                   15572:     my $captcha = Captcha::reCAPTCHA->new;
                   15573:     my $captcha_result =
                   15574:         $captcha->check_answer(
                   15575:                                 $privkey,
                   15576:                                 $ENV{'REMOTE_ADDR'},
                   15577:                                 $env{'form.recaptcha_challenge_field'},
                   15578:                                 $env{'form.recaptcha_response_field'},
                   15579:                               );
                   15580:     if ($captcha_result->{is_valid}) {
                   15581:         $captcha_chk = 1;
                   15582:     }
                   15583:     return $captcha_chk;
                   15584: }
                   15585: 
1.1075.2.64  raeburn  15586: sub emailusername_info {
1.1075.2.67  raeburn  15587:     my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1075.2.64  raeburn  15588:     my %titles = &Apache::lonlocal::texthash (
                   15589:                      lastname      => 'Last Name',
                   15590:                      firstname     => 'First Name',
                   15591:                      institution   => 'School/college/university',
                   15592:                      location      => "School's city, state/province, country",
                   15593:                      web           => "School's web address",
                   15594:                      officialemail => 'E-mail address at institution (if different)',
                   15595:                  );
                   15596:     return (\@fields,\%titles);
                   15597: }
                   15598: 
1.1075.2.56  raeburn  15599: sub cleanup_html {
                   15600:     my ($incoming) = @_;
                   15601:     my $outgoing;
                   15602:     if ($incoming ne '') {
                   15603:         $outgoing = $incoming;
                   15604:         $outgoing =~ s/;/&#059;/g;
                   15605:         $outgoing =~ s/\#/&#035;/g;
                   15606:         $outgoing =~ s/\&/&#038;/g;
                   15607:         $outgoing =~ s/</&#060;/g;
                   15608:         $outgoing =~ s/>/&#062;/g;
                   15609:         $outgoing =~ s/\(/&#040/g;
                   15610:         $outgoing =~ s/\)/&#041;/g;
                   15611:         $outgoing =~ s/"/&#034;/g;
                   15612:         $outgoing =~ s/'/&#039;/g;
                   15613:         $outgoing =~ s/\$/&#036;/g;
                   15614:         $outgoing =~ s{/}{&#047;}g;
                   15615:         $outgoing =~ s/=/&#061;/g;
                   15616:         $outgoing =~ s/\\/&#092;/g
                   15617:     }
                   15618:     return $outgoing;
                   15619: }
                   15620: 
1.1075.2.74  raeburn  15621: # Checks for critical messages and returns a redirect url if one exists.
                   15622: # $interval indicates how often to check for messages.
                   15623: sub critical_redirect {
                   15624:     my ($interval) = @_;
                   15625:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
                   15626:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                   15627:                                         $env{'user.name'});
                   15628:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
                   15629:         my $redirecturl;
                   15630:         if ($what[0]) {
                   15631:             if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   15632:                 $redirecturl='/adm/email?critical=display';
                   15633:                 my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   15634:                 return (1, $url);
                   15635:             }
                   15636:         }
                   15637:     }
                   15638:     return ();
                   15639: }
                   15640: 
1.1075.2.64  raeburn  15641: # Use:
                   15642: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   15643: #
                   15644: ##################################################
                   15645: #          password associated functions         #
                   15646: ##################################################
                   15647: sub des_keys {
                   15648:     # Make a new key for DES encryption.
                   15649:     # Each key has two parts which are returned separately.
                   15650:     # Please note:  Each key must be passed through the &hex function
                   15651:     # before it is output to the web browser.  The hex versions cannot
                   15652:     # be used to decrypt.
                   15653:     my @hexstr=('0','1','2','3','4','5','6','7',
                   15654:                 '8','9','a','b','c','d','e','f');
                   15655:     my $lkey='';
                   15656:     for (0..7) {
                   15657:         $lkey.=$hexstr[rand(15)];
                   15658:     }
                   15659:     my $ukey='';
                   15660:     for (0..7) {
                   15661:         $ukey.=$hexstr[rand(15)];
                   15662:     }
                   15663:     return ($lkey,$ukey);
                   15664: }
                   15665: 
                   15666: sub des_decrypt {
                   15667:     my ($key,$cyphertext) = @_;
                   15668:     my $keybin=pack("H16",$key);
                   15669:     my $cypher;
                   15670:     if ($Crypt::DES::VERSION>=2.03) {
                   15671:         $cypher=new Crypt::DES $keybin;
                   15672:     } else {
                   15673:         $cypher=new DES $keybin;
                   15674:     }
                   15675:     my $plaintext=
                   15676:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
                   15677:     $plaintext.=
                   15678:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
                   15679:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
                   15680:     return $plaintext;
                   15681: }
                   15682: 
1.112     bowersj2 15683: 1;
                   15684: __END__;
1.41      ng       15685: 

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