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

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.75! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.74 2014/05/22 12:26:49 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>'
                   1296:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
                   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.87      matthew  2344: =back
                   2345: 
1.157     matthew  2346: =back 
                   2347: 
1.87      matthew  2348: =cut
                   2349: 
                   2350: ###############################################################
                   2351: ###############################################################
                   2352: sub decode_user_agent {
1.247     albertel 2353:     my ($r)=@_;
1.87      matthew  2354:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2355:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2356:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2357:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2358:     my $clientbrowser='unknown';
                   2359:     my $clientversion='0';
                   2360:     my $clientmathml='';
                   2361:     my $clientunicode='0';
1.1075.2.42  raeburn  2362:     my $clientmobile=0;
1.87      matthew  2363:     for (my $i=0;$i<=$#browsertype;$i++) {
                   2364:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]);
                   2365: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2366: 	    $clientbrowser=$bname;
                   2367:             $httpbrowser=~/$vreg/i;
                   2368: 	    $clientversion=$1;
                   2369:             $clientmathml=($clientversion>=$minv);
                   2370:             $clientunicode=($clientversion>=$univ);
                   2371: 	}
                   2372:     }
                   2373:     my $clientos='unknown';
1.1075.2.42  raeburn  2374:     my $clientinfo;
1.87      matthew  2375:     if (($httpbrowser=~/linux/i) ||
                   2376:         ($httpbrowser=~/unix/i) ||
                   2377:         ($httpbrowser=~/ux/i) ||
                   2378:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2379:     if (($httpbrowser=~/vax/i) ||
                   2380:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2381:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2382:     if (($httpbrowser=~/mac/i) ||
                   2383:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
                   2384:     if ($httpbrowser=~/win/i) { $clientos='win'; }
                   2385:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42  raeburn  2386:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2387:         $clientmobile=lc($1);
                   2388:     }
                   2389:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2390:         $clientinfo = 'firefox-'.$1;
                   2391:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2392:         $clientinfo = 'chromeframe-'.$1;
                   2393:     }
1.87      matthew  2394:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.42  raeburn  2395:             $clientunicode,$clientos,$clientmobile,$clientinfo);
1.87      matthew  2396: }
                   2397: 
1.32      matthew  2398: ###############################################################
                   2399: ##    Authentication changing form generation subroutines    ##
                   2400: ###############################################################
                   2401: ##
                   2402: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2403: ## hash, and have reasonable default values.
                   2404: ##
                   2405: ##    formname = the name given in the <form> tag.
1.35      matthew  2406: #-------------------------------------------
                   2407: 
1.45      matthew  2408: =pod
                   2409: 
1.112     bowersj2 2410: =head1 Authentication Routines
                   2411: 
                   2412: =over 4
                   2413: 
1.648     raeburn  2414: =item * &authform_xxxxxx()
1.35      matthew  2415: 
                   2416: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2417: handle some of the conveniences required for authentication forms.  
                   2418: This is not an optimal method, but it works.  
                   2419: 
                   2420: =over 4
                   2421: 
1.112     bowersj2 2422: =item * authform_header
1.35      matthew  2423: 
1.112     bowersj2 2424: =item * authform_authorwarning
1.35      matthew  2425: 
1.112     bowersj2 2426: =item * authform_nochange
1.35      matthew  2427: 
1.112     bowersj2 2428: =item * authform_kerberos
1.35      matthew  2429: 
1.112     bowersj2 2430: =item * authform_internal
1.35      matthew  2431: 
1.112     bowersj2 2432: =item * authform_filesystem
1.35      matthew  2433: 
                   2434: =back
                   2435: 
1.648     raeburn  2436: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2437: 
1.35      matthew  2438: =cut
                   2439: 
                   2440: #-------------------------------------------
1.32      matthew  2441: sub authform_header{  
                   2442:     my %in = (
                   2443:         formname => 'cu',
1.80      albertel 2444:         kerb_def_dom => '',
1.32      matthew  2445:         @_,
                   2446:     );
                   2447:     $in{'formname'} = 'document.' . $in{'formname'};
                   2448:     my $result='';
1.80      albertel 2449: 
                   2450: #---------------------------------------------- Code for upper case translation
                   2451:     my $Javascript_toUpperCase;
                   2452:     unless ($in{kerb_def_dom}) {
                   2453:         $Javascript_toUpperCase =<<"END";
                   2454:         switch (choice) {
                   2455:            case 'krb': currentform.elements[choicearg].value =
                   2456:                currentform.elements[choicearg].value.toUpperCase();
                   2457:                break;
                   2458:            default:
                   2459:         }
                   2460: END
                   2461:     } else {
                   2462:         $Javascript_toUpperCase = "";
                   2463:     }
                   2464: 
1.165     raeburn  2465:     my $radioval = "'nochange'";
1.591     raeburn  2466:     if (defined($in{'curr_authtype'})) {
                   2467:         if ($in{'curr_authtype'} ne '') {
                   2468:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2469:         }
1.174     matthew  2470:     }
1.165     raeburn  2471:     my $argfield = 'null';
1.591     raeburn  2472:     if (defined($in{'mode'})) {
1.165     raeburn  2473:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2474:             if (defined($in{'curr_autharg'})) {
                   2475:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2476:                     $argfield = "'$in{'curr_autharg'}'";
                   2477:                 }
                   2478:             }
                   2479:         }
                   2480:     }
                   2481: 
1.32      matthew  2482:     $result.=<<"END";
                   2483: var current = new Object();
1.165     raeburn  2484: current.radiovalue = $radioval;
                   2485: current.argfield = $argfield;
1.32      matthew  2486: 
                   2487: function changed_radio(choice,currentform) {
                   2488:     var choicearg = choice + 'arg';
                   2489:     // If a radio button in changed, we need to change the argfield
                   2490:     if (current.radiovalue != choice) {
                   2491:         current.radiovalue = choice;
                   2492:         if (current.argfield != null) {
                   2493:             currentform.elements[current.argfield].value = '';
                   2494:         }
                   2495:         if (choice == 'nochange') {
                   2496:             current.argfield = null;
                   2497:         } else {
                   2498:             current.argfield = choicearg;
                   2499:             switch(choice) {
                   2500:                 case 'krb': 
                   2501:                     currentform.elements[current.argfield].value = 
                   2502:                         "$in{'kerb_def_dom'}";
                   2503:                 break;
                   2504:               default:
                   2505:                 break;
                   2506:             }
                   2507:         }
                   2508:     }
                   2509:     return;
                   2510: }
1.22      www      2511: 
1.32      matthew  2512: function changed_text(choice,currentform) {
                   2513:     var choicearg = choice + 'arg';
                   2514:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2515:         $Javascript_toUpperCase
1.32      matthew  2516:         // clear old field
                   2517:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2518:             currentform.elements[current.argfield].value = '';
                   2519:         }
                   2520:         current.argfield = choicearg;
                   2521:     }
                   2522:     set_auth_radio_buttons(choice,currentform);
                   2523:     return;
1.20      www      2524: }
1.32      matthew  2525: 
                   2526: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2527:     var numauthchoices = currentform.login.length;
                   2528:     if (typeof numauthchoices  == "undefined") {
                   2529:         return;
                   2530:     } 
1.32      matthew  2531:     var i=0;
1.986     raeburn  2532:     while (i < numauthchoices) {
1.32      matthew  2533:         if (currentform.login[i].value == newvalue) { break; }
                   2534:         i++;
                   2535:     }
1.986     raeburn  2536:     if (i == numauthchoices) {
1.32      matthew  2537:         return;
                   2538:     }
                   2539:     current.radiovalue = newvalue;
                   2540:     currentform.login[i].checked = true;
                   2541:     return;
                   2542: }
                   2543: END
                   2544:     return $result;
                   2545: }
                   2546: 
1.1075.2.20  raeburn  2547: sub authform_authorwarning {
1.32      matthew  2548:     my $result='';
1.144     matthew  2549:     $result='<i>'.
                   2550:         &mt('As a general rule, only authors or co-authors should be '.
                   2551:             'filesystem authenticated '.
                   2552:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2553:     return $result;
                   2554: }
                   2555: 
1.1075.2.20  raeburn  2556: sub authform_nochange {
1.32      matthew  2557:     my %in = (
                   2558:               formname => 'document.cu',
                   2559:               kerb_def_dom => 'MSU.EDU',
                   2560:               @_,
                   2561:           );
1.1075.2.20  raeburn  2562:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2563:     my $result;
1.1075.2.20  raeburn  2564:     if (!$authnum) {
                   2565:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2566:     } else {
                   2567:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2568:                   '<input type="radio" name="login" value="nochange" '.
                   2569:                   'checked="checked" onclick="'.
1.281     albertel 2570:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2571: 	    '</label>';
1.586     raeburn  2572:     }
1.32      matthew  2573:     return $result;
                   2574: }
                   2575: 
1.591     raeburn  2576: sub authform_kerberos {
1.32      matthew  2577:     my %in = (
                   2578:               formname => 'document.cu',
                   2579:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2580:               kerb_def_auth => 'krb4',
1.32      matthew  2581:               @_,
                   2582:               );
1.586     raeburn  2583:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2584:         $autharg,$jscall);
1.1075.2.20  raeburn  2585:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2586:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2587:        $check5 = ' checked="checked"';
1.80      albertel 2588:     } else {
1.772     bisitz   2589:        $check4 = ' checked="checked"';
1.80      albertel 2590:     }
1.165     raeburn  2591:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2592:     if (defined($in{'curr_authtype'})) {
                   2593:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2594:             $krbcheck = ' checked="checked"';
1.623     raeburn  2595:             if (defined($in{'mode'})) {
                   2596:                 if ($in{'mode'} eq 'modifyuser') {
                   2597:                     $krbcheck = '';
                   2598:                 }
                   2599:             }
1.591     raeburn  2600:             if (defined($in{'curr_kerb_ver'})) {
                   2601:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2602:                     $check5 = ' checked="checked"';
1.591     raeburn  2603:                     $check4 = '';
                   2604:                 } else {
1.772     bisitz   2605:                     $check4 = ' checked="checked"';
1.591     raeburn  2606:                     $check5 = '';
                   2607:                 }
1.586     raeburn  2608:             }
1.591     raeburn  2609:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2610:                 $krbarg = $in{'curr_autharg'};
                   2611:             }
1.586     raeburn  2612:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2613:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2614:                     $result = 
                   2615:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2616:         $in{'curr_autharg'},$krbver);
                   2617:                 } else {
                   2618:                     $result =
                   2619:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2620:                 }
                   2621:                 return $result; 
                   2622:             }
                   2623:         }
                   2624:     } else {
                   2625:         if ($authnum == 1) {
1.784     bisitz   2626:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2627:         }
                   2628:     }
1.586     raeburn  2629:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2630:         return;
1.587     raeburn  2631:     } elsif ($authtype eq '') {
1.591     raeburn  2632:         if (defined($in{'mode'})) {
1.587     raeburn  2633:             if ($in{'mode'} eq 'modifycourse') {
                   2634:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2635:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2636:                 }
                   2637:             }
                   2638:         }
1.586     raeburn  2639:     }
                   2640:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2641:     if ($authtype eq '') {
                   2642:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2643:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2644:                     $krbcheck.' />';
                   2645:     }
                   2646:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20  raeburn  2647:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2648:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  2649:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2650:          $in{'curr_authtype'} eq 'krb4')) {
                   2651:         $result .= &mt
1.144     matthew  2652:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2653:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2654:          '<label>'.$authtype,
1.281     albertel 2655:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2656:              'value="'.$krbarg.'" '.
1.144     matthew  2657:              'onchange="'.$jscall.'" />',
1.281     albertel 2658:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2659:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2660: 	 '</label>');
1.586     raeburn  2661:     } elsif ($can_assign{'krb4'}) {
                   2662:         $result .= &mt
                   2663:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2664:          '[_3] Version 4 [_4]',
                   2665:          '<label>'.$authtype,
                   2666:          '</label><input type="text" size="10" name="krbarg" '.
                   2667:              'value="'.$krbarg.'" '.
                   2668:              'onchange="'.$jscall.'" />',
                   2669:          '<label><input type="hidden" name="krbver" value="4" />',
                   2670:          '</label>');
                   2671:     } elsif ($can_assign{'krb5'}) {
                   2672:         $result .= &mt
                   2673:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2674:          '[_3] Version 5 [_4]',
                   2675:          '<label>'.$authtype,
                   2676:          '</label><input type="text" size="10" name="krbarg" '.
                   2677:              'value="'.$krbarg.'" '.
                   2678:              'onchange="'.$jscall.'" />',
                   2679:          '<label><input type="hidden" name="krbver" value="5" />',
                   2680:          '</label>');
                   2681:     }
1.32      matthew  2682:     return $result;
                   2683: }
                   2684: 
1.1075.2.20  raeburn  2685: sub authform_internal {
1.586     raeburn  2686:     my %in = (
1.32      matthew  2687:                 formname => 'document.cu',
                   2688:                 kerb_def_dom => 'MSU.EDU',
                   2689:                 @_,
                   2690:                 );
1.586     raeburn  2691:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2692:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2693:     if (defined($in{'curr_authtype'})) {
                   2694:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2695:             if ($can_assign{'int'}) {
1.772     bisitz   2696:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2697:                 if (defined($in{'mode'})) {
                   2698:                     if ($in{'mode'} eq 'modifyuser') {
                   2699:                         $intcheck = '';
                   2700:                     }
                   2701:                 }
1.591     raeburn  2702:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2703:                     $intarg = $in{'curr_autharg'};
                   2704:                 }
                   2705:             } else {
                   2706:                 $result = &mt('Currently internally authenticated.');
                   2707:                 return $result;
1.165     raeburn  2708:             }
                   2709:         }
1.586     raeburn  2710:     } else {
                   2711:         if ($authnum == 1) {
1.784     bisitz   2712:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2713:         }
                   2714:     }
                   2715:     if (!$can_assign{'int'}) {
                   2716:         return;
1.587     raeburn  2717:     } elsif ($authtype eq '') {
1.591     raeburn  2718:         if (defined($in{'mode'})) {
1.587     raeburn  2719:             if ($in{'mode'} eq 'modifycourse') {
                   2720:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2721:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2722:                 }
                   2723:             }
                   2724:         }
1.165     raeburn  2725:     }
1.586     raeburn  2726:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2727:     if ($authtype eq '') {
                   2728:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2729:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2730:     }
1.605     bisitz   2731:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2732:                $intarg.'" onchange="'.$jscall.'" />';
                   2733:     $result = &mt
1.144     matthew  2734:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2735:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2736:     $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  2737:     return $result;
                   2738: }
                   2739: 
1.1075.2.20  raeburn  2740: sub authform_local {
1.32      matthew  2741:     my %in = (
                   2742:               formname => 'document.cu',
                   2743:               kerb_def_dom => 'MSU.EDU',
                   2744:               @_,
                   2745:               );
1.586     raeburn  2746:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2747:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2748:     if (defined($in{'curr_authtype'})) {
                   2749:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2750:             if ($can_assign{'loc'}) {
1.772     bisitz   2751:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2752:                 if (defined($in{'mode'})) {
                   2753:                     if ($in{'mode'} eq 'modifyuser') {
                   2754:                         $loccheck = '';
                   2755:                     }
                   2756:                 }
1.591     raeburn  2757:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2758:                     $locarg = $in{'curr_autharg'};
                   2759:                 }
                   2760:             } else {
                   2761:                 $result = &mt('Currently using local (institutional) authentication.');
                   2762:                 return $result;
1.165     raeburn  2763:             }
                   2764:         }
1.586     raeburn  2765:     } else {
                   2766:         if ($authnum == 1) {
1.784     bisitz   2767:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2768:         }
                   2769:     }
                   2770:     if (!$can_assign{'loc'}) {
                   2771:         return;
1.587     raeburn  2772:     } elsif ($authtype eq '') {
1.591     raeburn  2773:         if (defined($in{'mode'})) {
1.587     raeburn  2774:             if ($in{'mode'} eq 'modifycourse') {
                   2775:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2776:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2777:                 }
                   2778:             }
                   2779:         }
1.165     raeburn  2780:     }
1.586     raeburn  2781:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2782:     if ($authtype eq '') {
                   2783:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2784:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2785:                     $jscall.'" />';
                   2786:     }
                   2787:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2788:                $locarg.'" onchange="'.$jscall.'" />';
                   2789:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2790:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2791:     return $result;
                   2792: }
                   2793: 
1.1075.2.20  raeburn  2794: sub authform_filesystem {
1.32      matthew  2795:     my %in = (
                   2796:               formname => 'document.cu',
                   2797:               kerb_def_dom => 'MSU.EDU',
                   2798:               @_,
                   2799:               );
1.586     raeburn  2800:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2801:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2802:     if (defined($in{'curr_authtype'})) {
                   2803:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2804:             if ($can_assign{'fsys'}) {
1.772     bisitz   2805:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2806:                 if (defined($in{'mode'})) {
                   2807:                     if ($in{'mode'} eq 'modifyuser') {
                   2808:                         $fsyscheck = '';
                   2809:                     }
                   2810:                 }
1.586     raeburn  2811:             } else {
                   2812:                 $result = &mt('Currently Filesystem Authenticated.');
                   2813:                 return $result;
                   2814:             }           
                   2815:         }
                   2816:     } else {
                   2817:         if ($authnum == 1) {
1.784     bisitz   2818:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2819:         }
                   2820:     }
                   2821:     if (!$can_assign{'fsys'}) {
                   2822:         return;
1.587     raeburn  2823:     } elsif ($authtype eq '') {
1.591     raeburn  2824:         if (defined($in{'mode'})) {
1.587     raeburn  2825:             if ($in{'mode'} eq 'modifycourse') {
                   2826:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2827:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2828:                 }
                   2829:             }
                   2830:         }
1.586     raeburn  2831:     }
                   2832:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2833:     if ($authtype eq '') {
                   2834:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2835:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2836:                     $jscall.'" />';
                   2837:     }
                   2838:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2839:                ' onchange="'.$jscall.'" />';
                   2840:     $result = &mt
1.144     matthew  2841:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2842:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2843:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2844:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2845:                   'onchange="'.$jscall.'" />');
1.32      matthew  2846:     return $result;
                   2847: }
                   2848: 
1.586     raeburn  2849: sub get_assignable_auth {
                   2850:     my ($dom) = @_;
                   2851:     if ($dom eq '') {
                   2852:         $dom = $env{'request.role.domain'};
                   2853:     }
                   2854:     my %can_assign = (
                   2855:                           krb4 => 1,
                   2856:                           krb5 => 1,
                   2857:                           int  => 1,
                   2858:                           loc  => 1,
                   2859:                      );
                   2860:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2861:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2862:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2863:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2864:             my $context;
                   2865:             if ($env{'request.role'} =~ /^au/) {
                   2866:                 $context = 'author';
                   2867:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2868:                 $context = 'domain';
                   2869:             } elsif ($env{'request.course.id'}) {
                   2870:                 $context = 'course';
                   2871:             }
                   2872:             if ($context) {
                   2873:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2874:                    %can_assign = %{$authhash->{$context}}; 
                   2875:                 }
                   2876:             }
                   2877:         }
                   2878:     }
                   2879:     my $authnum = 0;
                   2880:     foreach my $key (keys(%can_assign)) {
                   2881:         if ($can_assign{$key}) {
                   2882:             $authnum ++;
                   2883:         }
                   2884:     }
                   2885:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2886:         $authnum --;
                   2887:     }
                   2888:     return ($authnum,%can_assign);
                   2889: }
                   2890: 
1.80      albertel 2891: ###############################################################
                   2892: ##    Get Kerberos Defaults for Domain                 ##
                   2893: ###############################################################
                   2894: ##
                   2895: ## Returns default kerberos version and an associated argument
                   2896: ## as listed in file domain.tab. If not listed, provides
                   2897: ## appropriate default domain and kerberos version.
                   2898: ##
                   2899: #-------------------------------------------
                   2900: 
                   2901: =pod
                   2902: 
1.648     raeburn  2903: =item * &get_kerberos_defaults()
1.80      albertel 2904: 
                   2905: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2906: version and domain. If not found, it defaults to version 4 and the 
                   2907: domain of the server.
1.80      albertel 2908: 
1.648     raeburn  2909: =over 4
                   2910: 
1.80      albertel 2911: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2912: 
1.648     raeburn  2913: =back
                   2914: 
                   2915: =back
                   2916: 
1.80      albertel 2917: =cut
                   2918: 
                   2919: #-------------------------------------------
                   2920: sub get_kerberos_defaults {
                   2921:     my $domain=shift;
1.641     raeburn  2922:     my ($krbdef,$krbdefdom);
                   2923:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2924:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2925:         $krbdef = $domdefaults{'auth_def'};
                   2926:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2927:     } else {
1.80      albertel 2928:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2929:         my $krbdefdom=$1;
                   2930:         $krbdefdom=~tr/a-z/A-Z/;
                   2931:         $krbdef = "krb4";
                   2932:     }
                   2933:     return ($krbdef,$krbdefdom);
                   2934: }
1.112     bowersj2 2935: 
1.32      matthew  2936: 
1.46      matthew  2937: ###############################################################
                   2938: ##                Thesaurus Functions                        ##
                   2939: ###############################################################
1.20      www      2940: 
1.46      matthew  2941: =pod
1.20      www      2942: 
1.112     bowersj2 2943: =head1 Thesaurus Functions
                   2944: 
                   2945: =over 4
                   2946: 
1.648     raeburn  2947: =item * &initialize_keywords()
1.46      matthew  2948: 
                   2949: Initializes the package variable %Keywords if it is empty.  Uses the
                   2950: package variable $thesaurus_db_file.
                   2951: 
                   2952: =cut
                   2953: 
                   2954: ###################################################
                   2955: 
                   2956: sub initialize_keywords {
                   2957:     return 1 if (scalar keys(%Keywords));
                   2958:     # If we are here, %Keywords is empty, so fill it up
                   2959:     #   Make sure the file we need exists...
                   2960:     if (! -e $thesaurus_db_file) {
                   2961:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2962:                                  " failed because it does not exist");
                   2963:         return 0;
                   2964:     }
                   2965:     #   Set up the hash as a database
                   2966:     my %thesaurus_db;
                   2967:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2968:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2969:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2970:                                  $thesaurus_db_file);
                   2971:         return 0;
                   2972:     } 
                   2973:     #  Get the average number of appearances of a word.
                   2974:     my $avecount = $thesaurus_db{'average.count'};
                   2975:     #  Put keywords (those that appear > average) into %Keywords
                   2976:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2977:         my ($count,undef) = split /:/,$data;
                   2978:         $Keywords{$word}++ if ($count > $avecount);
                   2979:     }
                   2980:     untie %thesaurus_db;
                   2981:     # Remove special values from %Keywords.
1.356     albertel 2982:     foreach my $value ('total.count','average.count') {
                   2983:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2984:   }
1.46      matthew  2985:     return 1;
                   2986: }
                   2987: 
                   2988: ###################################################
                   2989: 
                   2990: =pod
                   2991: 
1.648     raeburn  2992: =item * &keyword($word)
1.46      matthew  2993: 
                   2994: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   2995: than the average number of times in the thesaurus database.  Calls 
                   2996: &initialize_keywords
                   2997: 
                   2998: =cut
                   2999: 
                   3000: ###################################################
1.20      www      3001: 
                   3002: sub keyword {
1.46      matthew  3003:     return if (!&initialize_keywords());
                   3004:     my $word=lc(shift());
                   3005:     $word=~s/\W//g;
                   3006:     return exists($Keywords{$word});
1.20      www      3007: }
1.46      matthew  3008: 
                   3009: ###############################################################
                   3010: 
                   3011: =pod 
1.20      www      3012: 
1.648     raeburn  3013: =item * &get_related_words()
1.46      matthew  3014: 
1.160     matthew  3015: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3016: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3017: will be returned.  The order of the words returned is determined by the
                   3018: database which holds them.
                   3019: 
                   3020: Uses global $thesaurus_db_file.
                   3021: 
1.1057    foxr     3022: 
1.46      matthew  3023: =cut
                   3024: 
                   3025: ###############################################################
                   3026: sub get_related_words {
                   3027:     my $keyword = shift;
                   3028:     my %thesaurus_db;
                   3029:     if (! -e $thesaurus_db_file) {
                   3030:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3031:                                  "failed because the file does not exist");
                   3032:         return ();
                   3033:     }
                   3034:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3035:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3036:         return ();
                   3037:     } 
                   3038:     my @Words=();
1.429     www      3039:     my $count=0;
1.46      matthew  3040:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3041: 	# The first element is the number of times
                   3042: 	# the word appears.  We do not need it now.
1.429     www      3043: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3044: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3045: 	my $threshold=$mostfrequentcount/10;
                   3046:         foreach my $possibleword (@RelatedWords) {
                   3047:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3048:             if ($wordcount>$threshold) {
                   3049: 		push(@Words,$word);
                   3050:                 $count++;
                   3051:                 if ($count>10) { last; }
                   3052: 	    }
1.20      www      3053:         }
                   3054:     }
1.46      matthew  3055:     untie %thesaurus_db;
                   3056:     return @Words;
1.14      harris41 3057: }
1.46      matthew  3058: 
1.112     bowersj2 3059: =pod
                   3060: 
                   3061: =back
                   3062: 
                   3063: =cut
1.61      www      3064: 
                   3065: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3066: =pod
                   3067: 
1.112     bowersj2 3068: =head1 User Name Functions
                   3069: 
                   3070: =over 4
                   3071: 
1.648     raeburn  3072: =item * &plainname($uname,$udom,$first)
1.81      albertel 3073: 
1.112     bowersj2 3074: Takes a users logon name and returns it as a string in
1.226     albertel 3075: "first middle last generation" form 
                   3076: if $first is set to 'lastname' then it returns it as
                   3077: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3078: 
                   3079: =cut
1.61      www      3080: 
1.295     www      3081: 
1.81      albertel 3082: ###############################################################
1.61      www      3083: sub plainname {
1.226     albertel 3084:     my ($uname,$udom,$first)=@_;
1.537     albertel 3085:     return if (!defined($uname) || !defined($udom));
1.295     www      3086:     my %names=&getnames($uname,$udom);
1.226     albertel 3087:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3088: 					  $names{'middlename'},
                   3089: 					  $names{'lastname'},
                   3090: 					  $names{'generation'},$first);
                   3091:     $name=~s/^\s+//;
1.62      www      3092:     $name=~s/\s+$//;
                   3093:     $name=~s/\s+/ /g;
1.353     albertel 3094:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3095:     return $name;
1.61      www      3096: }
1.66      www      3097: 
                   3098: # -------------------------------------------------------------------- Nickname
1.81      albertel 3099: =pod
                   3100: 
1.648     raeburn  3101: =item * &nickname($uname,$udom)
1.81      albertel 3102: 
                   3103: Gets a users name and returns it as a string as
                   3104: 
                   3105: "&quot;nickname&quot;"
1.66      www      3106: 
1.81      albertel 3107: if the user has a nickname or
                   3108: 
                   3109: "first middle last generation"
                   3110: 
                   3111: if the user does not
                   3112: 
                   3113: =cut
1.66      www      3114: 
                   3115: sub nickname {
                   3116:     my ($uname,$udom)=@_;
1.537     albertel 3117:     return if (!defined($uname) || !defined($udom));
1.295     www      3118:     my %names=&getnames($uname,$udom);
1.68      albertel 3119:     my $name=$names{'nickname'};
1.66      www      3120:     if ($name) {
                   3121:        $name='&quot;'.$name.'&quot;'; 
                   3122:     } else {
                   3123:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3124: 	     $names{'lastname'}.' '.$names{'generation'};
                   3125:        $name=~s/\s+$//;
                   3126:        $name=~s/\s+/ /g;
                   3127:     }
                   3128:     return $name;
                   3129: }
                   3130: 
1.295     www      3131: sub getnames {
                   3132:     my ($uname,$udom)=@_;
1.537     albertel 3133:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3134:     if ($udom eq 'public' && $uname eq 'public') {
                   3135: 	return ('lastname' => &mt('Public'));
                   3136:     }
1.295     www      3137:     my $id=$uname.':'.$udom;
                   3138:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3139:     if ($cached) {
                   3140: 	return %{$names};
                   3141:     } else {
                   3142: 	my %loadnames=&Apache::lonnet::get('environment',
                   3143:                     ['firstname','middlename','lastname','generation','nickname'],
                   3144: 					 $udom,$uname);
                   3145: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3146: 	return %loadnames;
                   3147:     }
                   3148: }
1.61      www      3149: 
1.542     raeburn  3150: # -------------------------------------------------------------------- getemails
1.648     raeburn  3151: 
1.542     raeburn  3152: =pod
                   3153: 
1.648     raeburn  3154: =item * &getemails($uname,$udom)
1.542     raeburn  3155: 
                   3156: Gets a user's email information and returns it as a hash with keys:
                   3157: notification, critnotification, permanentemail
                   3158: 
                   3159: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3160: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3161:  
1.648     raeburn  3162: 
1.542     raeburn  3163: =cut
                   3164: 
1.648     raeburn  3165: 
1.466     albertel 3166: sub getemails {
                   3167:     my ($uname,$udom)=@_;
                   3168:     if ($udom eq 'public' && $uname eq 'public') {
                   3169: 	return;
                   3170:     }
1.467     www      3171:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3172:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3173:     my $id=$uname.':'.$udom;
                   3174:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3175:     if ($cached) {
                   3176: 	return %{$names};
                   3177:     } else {
                   3178: 	my %loadnames=&Apache::lonnet::get('environment',
                   3179:                     			   ['notification','critnotification',
                   3180: 					    'permanentemail'],
                   3181: 					   $udom,$uname);
                   3182: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3183: 	return %loadnames;
                   3184:     }
                   3185: }
                   3186: 
1.551     albertel 3187: sub flush_email_cache {
                   3188:     my ($uname,$udom)=@_;
                   3189:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3190:     if (!$uname) { $uname=$env{'user.name'};   }
                   3191:     return if ($udom eq 'public' && $uname eq 'public');
                   3192:     my $id=$uname.':'.$udom;
                   3193:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3194: }
                   3195: 
1.728     raeburn  3196: # -------------------------------------------------------------------- getlangs
                   3197: 
                   3198: =pod
                   3199: 
                   3200: =item * &getlangs($uname,$udom)
                   3201: 
                   3202: Gets a user's language preference and returns it as a hash with key:
                   3203: language.
                   3204: 
                   3205: =cut
                   3206: 
                   3207: 
                   3208: sub getlangs {
                   3209:     my ($uname,$udom) = @_;
                   3210:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3211:     if (!$uname) { $uname=$env{'user.name'};   }
                   3212:     my $id=$uname.':'.$udom;
                   3213:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3214:     if ($cached) {
                   3215:         return %{$langs};
                   3216:     } else {
                   3217:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3218:                                            $udom,$uname);
                   3219:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3220:         return %loadlangs;
                   3221:     }
                   3222: }
                   3223: 
                   3224: sub flush_langs_cache {
                   3225:     my ($uname,$udom)=@_;
                   3226:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3227:     if (!$uname) { $uname=$env{'user.name'};   }
                   3228:     return if ($udom eq 'public' && $uname eq 'public');
                   3229:     my $id=$uname.':'.$udom;
                   3230:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3231: }
                   3232: 
1.61      www      3233: # ------------------------------------------------------------------ Screenname
1.81      albertel 3234: 
                   3235: =pod
                   3236: 
1.648     raeburn  3237: =item * &screenname($uname,$udom)
1.81      albertel 3238: 
                   3239: Gets a users screenname and returns it as a string
                   3240: 
                   3241: =cut
1.61      www      3242: 
                   3243: sub screenname {
                   3244:     my ($uname,$udom)=@_;
1.258     albertel 3245:     if ($uname eq $env{'user.name'} &&
                   3246: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3247:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3248:     return $names{'screenname'};
1.62      www      3249: }
                   3250: 
1.212     albertel 3251: 
1.802     bisitz   3252: # ------------------------------------------------------------- Confirm Wrapper
                   3253: =pod
                   3254: 
1.1075.2.42  raeburn  3255: =item * &confirmwrapper($message)
1.802     bisitz   3256: 
                   3257: Wrap messages about completion of operation in box
                   3258: 
                   3259: =cut
                   3260: 
                   3261: sub confirmwrapper {
                   3262:     my ($message)=@_;
                   3263:     if ($message) {
                   3264:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3265:                .$message."\n"
                   3266:                .'</div>'."\n";
                   3267:     } else {
                   3268:         return $message;
                   3269:     }
                   3270: }
                   3271: 
1.62      www      3272: # ------------------------------------------------------------- Message Wrapper
                   3273: 
                   3274: sub messagewrapper {
1.369     www      3275:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3276:     return 
1.441     albertel 3277:         '<a href="/adm/email?compose=individual&amp;'.
                   3278:         'recname='.$username.'&amp;recdom='.$domain.
                   3279: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3280:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3281: }
1.802     bisitz   3282: 
1.74      www      3283: # --------------------------------------------------------------- Notes Wrapper
                   3284: 
                   3285: sub noteswrapper {
                   3286:     my ($link,$un,$do)=@_;
                   3287:     return 
1.896     amueller 3288: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3289: }
1.802     bisitz   3290: 
1.62      www      3291: # ------------------------------------------------------------- Aboutme Wrapper
                   3292: 
                   3293: sub aboutmewrapper {
1.1070    raeburn  3294:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3295:     if (!defined($username)  && !defined($domain)) {
                   3296:         return;
                   3297:     }
1.1075.2.15  raeburn  3298:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3299: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3300: }
                   3301: 
                   3302: # ------------------------------------------------------------ Syllabus Wrapper
                   3303: 
                   3304: sub syllabuswrapper {
1.707     bisitz   3305:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3306:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3307: }
1.14      harris41 3308: 
1.802     bisitz   3309: # -----------------------------------------------------------------------------
                   3310: 
1.208     matthew  3311: sub track_student_link {
1.887     raeburn  3312:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3313:     my $link ="/adm/trackstudent?";
1.208     matthew  3314:     my $title = 'View recent activity';
                   3315:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3316:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3317:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3318:         $title .= ' of this student';
1.268     albertel 3319:     } 
1.208     matthew  3320:     if (defined($target) && $target !~ /^\s*$/) {
                   3321:         $target = qq{target="$target"};
                   3322:     } else {
                   3323:         $target = '';
                   3324:     }
1.268     albertel 3325:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3326:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3327:     $title = &mt($title);
                   3328:     $linktext = &mt($linktext);
1.448     albertel 3329:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3330: 	&help_open_topic('View_recent_activity');
1.208     matthew  3331: }
                   3332: 
1.781     raeburn  3333: sub slot_reservations_link {
                   3334:     my ($linktext,$sname,$sdom,$target) = @_;
                   3335:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3336:     my $title = 'View slot reservation history';
                   3337:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3338:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3339:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3340:         $title .= ' of this student';
                   3341:     }
                   3342:     if (defined($target) && $target !~ /^\s*$/) {
                   3343:         $target = qq{target="$target"};
                   3344:     } else {
                   3345:         $target = '';
                   3346:     }
                   3347:     $title = &mt($title);
                   3348:     $linktext = &mt($linktext);
                   3349:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3350: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3351: 
                   3352: }
                   3353: 
1.508     www      3354: # ===================================================== Display a student photo
                   3355: 
                   3356: 
1.509     albertel 3357: sub student_image_tag {
1.508     www      3358:     my ($domain,$user)=@_;
                   3359:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3360:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3361: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3362:     } else {
                   3363: 	return '';
                   3364:     }
                   3365: }
                   3366: 
1.112     bowersj2 3367: =pod
                   3368: 
                   3369: =back
                   3370: 
                   3371: =head1 Access .tab File Data
                   3372: 
                   3373: =over 4
                   3374: 
1.648     raeburn  3375: =item * &languageids() 
1.112     bowersj2 3376: 
                   3377: returns list of all language ids
                   3378: 
                   3379: =cut
                   3380: 
1.14      harris41 3381: sub languageids {
1.16      harris41 3382:     return sort(keys(%language));
1.14      harris41 3383: }
                   3384: 
1.112     bowersj2 3385: =pod
                   3386: 
1.648     raeburn  3387: =item * &languagedescription() 
1.112     bowersj2 3388: 
                   3389: returns description of a specified language id
                   3390: 
                   3391: =cut
                   3392: 
1.14      harris41 3393: sub languagedescription {
1.125     www      3394:     my $code=shift;
                   3395:     return  ($supported_language{$code}?'* ':'').
                   3396:             $language{$code}.
1.126     www      3397: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3398: }
                   3399: 
1.1048    foxr     3400: =pod
                   3401: 
                   3402: =item * &plainlanguagedescription
                   3403: 
                   3404: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3405: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3406: 
                   3407: =cut
                   3408: 
1.145     www      3409: sub plainlanguagedescription {
                   3410:     my $code=shift;
                   3411:     return $language{$code};
                   3412: }
                   3413: 
1.1048    foxr     3414: =pod
                   3415: 
                   3416: =item * &supportedlanguagecode
                   3417: 
                   3418: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3419: code.
                   3420: 
                   3421: =cut
                   3422: 
1.145     www      3423: sub supportedlanguagecode {
                   3424:     my $code=shift;
                   3425:     return $supported_language{$code};
1.97      www      3426: }
                   3427: 
1.112     bowersj2 3428: =pod
                   3429: 
1.1048    foxr     3430: =item * &latexlanguage()
                   3431: 
                   3432: Given a language key code returns the correspondnig language to use
                   3433: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3434: is no supported hyphenation for the language code.
                   3435: 
                   3436: =cut
                   3437: 
                   3438: sub latexlanguage {
                   3439:     my $code = shift;
                   3440:     return $latex_language{$code};
                   3441: }
                   3442: 
                   3443: =pod
                   3444: 
                   3445: =item * &latexhyphenation()
                   3446: 
                   3447: Same as above but what's supplied is the language as it might be stored
                   3448: in the metadata.
                   3449: 
                   3450: =cut
                   3451: 
                   3452: sub latexhyphenation {
                   3453:     my $key = shift;
                   3454:     return $latex_language_bykey{$key};
                   3455: }
                   3456: 
                   3457: =pod
                   3458: 
1.648     raeburn  3459: =item * &copyrightids() 
1.112     bowersj2 3460: 
                   3461: returns list of all copyrights
                   3462: 
                   3463: =cut
                   3464: 
                   3465: sub copyrightids {
                   3466:     return sort(keys(%cprtag));
                   3467: }
                   3468: 
                   3469: =pod
                   3470: 
1.648     raeburn  3471: =item * &copyrightdescription() 
1.112     bowersj2 3472: 
                   3473: returns description of a specified copyright id
                   3474: 
                   3475: =cut
                   3476: 
                   3477: sub copyrightdescription {
1.166     www      3478:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3479: }
1.197     matthew  3480: 
                   3481: =pod
                   3482: 
1.648     raeburn  3483: =item * &source_copyrightids() 
1.192     taceyjo1 3484: 
                   3485: returns list of all source copyrights
                   3486: 
                   3487: =cut
                   3488: 
                   3489: sub source_copyrightids {
                   3490:     return sort(keys(%scprtag));
                   3491: }
                   3492: 
                   3493: =pod
                   3494: 
1.648     raeburn  3495: =item * &source_copyrightdescription() 
1.192     taceyjo1 3496: 
                   3497: returns description of a specified source copyright id
                   3498: 
                   3499: =cut
                   3500: 
                   3501: sub source_copyrightdescription {
                   3502:     return &mt($scprtag{shift(@_)});
                   3503: }
1.112     bowersj2 3504: 
                   3505: =pod
                   3506: 
1.648     raeburn  3507: =item * &filecategories() 
1.112     bowersj2 3508: 
                   3509: returns list of all file categories
                   3510: 
                   3511: =cut
                   3512: 
                   3513: sub filecategories {
                   3514:     return sort(keys(%category_extensions));
                   3515: }
                   3516: 
                   3517: =pod
                   3518: 
1.648     raeburn  3519: =item * &filecategorytypes() 
1.112     bowersj2 3520: 
                   3521: returns list of file types belonging to a given file
                   3522: category
                   3523: 
                   3524: =cut
                   3525: 
                   3526: sub filecategorytypes {
1.356     albertel 3527:     my ($cat) = @_;
                   3528:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3529: }
                   3530: 
                   3531: =pod
                   3532: 
1.648     raeburn  3533: =item * &fileembstyle() 
1.112     bowersj2 3534: 
                   3535: returns embedding style for a specified file type
                   3536: 
                   3537: =cut
                   3538: 
                   3539: sub fileembstyle {
                   3540:     return $fe{lc(shift(@_))};
1.169     www      3541: }
                   3542: 
1.351     www      3543: sub filemimetype {
                   3544:     return $fm{lc(shift(@_))};
                   3545: }
                   3546: 
1.169     www      3547: 
                   3548: sub filecategoryselect {
                   3549:     my ($name,$value)=@_;
1.189     matthew  3550:     return &select_form($value,$name,
1.970     raeburn  3551:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3552: }
                   3553: 
                   3554: =pod
                   3555: 
1.648     raeburn  3556: =item * &filedescription() 
1.112     bowersj2 3557: 
                   3558: returns description for a specified file type
                   3559: 
                   3560: =cut
                   3561: 
                   3562: sub filedescription {
1.188     matthew  3563:     my $file_description = $fd{lc(shift())};
                   3564:     $file_description =~ s:([\[\]]):~$1:g;
                   3565:     return &mt($file_description);
1.112     bowersj2 3566: }
                   3567: 
                   3568: =pod
                   3569: 
1.648     raeburn  3570: =item * &filedescriptionex() 
1.112     bowersj2 3571: 
                   3572: returns description for a specified file type with
                   3573: extra formatting
                   3574: 
                   3575: =cut
                   3576: 
                   3577: sub filedescriptionex {
                   3578:     my $ex=shift;
1.188     matthew  3579:     my $file_description = $fd{lc($ex)};
                   3580:     $file_description =~ s:([\[\]]):~$1:g;
                   3581:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3582: }
                   3583: 
                   3584: # End of .tab access
                   3585: =pod
                   3586: 
                   3587: =back
                   3588: 
                   3589: =cut
                   3590: 
                   3591: # ------------------------------------------------------------------ File Types
                   3592: sub fileextensions {
                   3593:     return sort(keys(%fe));
                   3594: }
                   3595: 
1.97      www      3596: # ----------------------------------------------------------- Display Languages
                   3597: # returns a hash with all desired display languages
                   3598: #
                   3599: 
                   3600: sub display_languages {
                   3601:     my %languages=();
1.695     raeburn  3602:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3603: 	$languages{$lang}=1;
1.97      www      3604:     }
                   3605:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3606:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3607: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3608: 	    $languages{$lang}=1;
1.97      www      3609:         }
                   3610:     }
                   3611:     return %languages;
1.14      harris41 3612: }
                   3613: 
1.582     albertel 3614: sub languages {
                   3615:     my ($possible_langs) = @_;
1.695     raeburn  3616:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3617:     if (!ref($possible_langs)) {
                   3618: 	if( wantarray ) {
                   3619: 	    return @preferred_langs;
                   3620: 	} else {
                   3621: 	    return $preferred_langs[0];
                   3622: 	}
                   3623:     }
                   3624:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3625:     my @preferred_possibilities;
                   3626:     foreach my $preferred_lang (@preferred_langs) {
                   3627: 	if (exists($possibilities{$preferred_lang})) {
                   3628: 	    push(@preferred_possibilities, $preferred_lang);
                   3629: 	}
                   3630:     }
                   3631:     if( wantarray ) {
                   3632: 	return @preferred_possibilities;
                   3633:     }
                   3634:     return $preferred_possibilities[0];
                   3635: }
                   3636: 
1.742     raeburn  3637: sub user_lang {
                   3638:     my ($touname,$toudom,$fromcid) = @_;
                   3639:     my @userlangs;
                   3640:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3641:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3642:                     $env{'course.'.$fromcid.'.languages'}));
                   3643:     } else {
                   3644:         my %langhash = &getlangs($touname,$toudom);
                   3645:         if ($langhash{'languages'} ne '') {
                   3646:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3647:         } else {
                   3648:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3649:             if ($domdefs{'lang_def'} ne '') {
                   3650:                 @userlangs = ($domdefs{'lang_def'});
                   3651:             }
                   3652:         }
                   3653:     }
                   3654:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3655:     my $user_lh = Apache::localize->get_handle(@languages);
                   3656:     return $user_lh;
                   3657: }
                   3658: 
                   3659: 
1.112     bowersj2 3660: ###############################################################
                   3661: ##               Student Answer Attempts                     ##
                   3662: ###############################################################
                   3663: 
                   3664: =pod
                   3665: 
                   3666: =head1 Alternate Problem Views
                   3667: 
                   3668: =over 4
                   3669: 
1.648     raeburn  3670: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3671:     $getattempt, $regexp, $gradesub)
                   3672: 
                   3673: Return string with previous attempt on problem. Arguments:
                   3674: 
                   3675: =over 4
                   3676: 
                   3677: =item * $symb: Problem, including path
                   3678: 
                   3679: =item * $username: username of the desired student
                   3680: 
                   3681: =item * $domain: domain of the desired student
1.14      harris41 3682: 
1.112     bowersj2 3683: =item * $course: Course ID
1.14      harris41 3684: 
1.112     bowersj2 3685: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3686:     something
1.14      harris41 3687: 
1.112     bowersj2 3688: =item * $regexp: if string matches this regexp, the string will be
                   3689:     sent to $gradesub
1.14      harris41 3690: 
1.112     bowersj2 3691: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3692: 
1.112     bowersj2 3693: =back
1.14      harris41 3694: 
1.112     bowersj2 3695: The output string is a table containing all desired attempts, if any.
1.16      harris41 3696: 
1.112     bowersj2 3697: =cut
1.1       albertel 3698: 
                   3699: sub get_previous_attempt {
1.43      ng       3700:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3701:   my $prevattempts='';
1.43      ng       3702:   no strict 'refs';
1.1       albertel 3703:   if ($symb) {
1.3       albertel 3704:     my (%returnhash)=
                   3705:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3706:     if ($returnhash{'version'}) {
                   3707:       my %lasthash=();
                   3708:       my $version;
                   3709:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3710:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3711: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3712:         }
1.1       albertel 3713:       }
1.596     albertel 3714:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3715:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3716:       my (%typeparts,%lasthidden);
1.945     raeburn  3717:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3718:       foreach my $key (sort(keys(%lasthash))) {
                   3719: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3720: 	if ($#parts > 0) {
1.31      albertel 3721: 	  my $data=$parts[-1];
1.989     raeburn  3722:           next if ($data eq 'foilorder');
1.31      albertel 3723: 	  pop(@parts);
1.1010    www      3724:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3725:           if ($data eq 'type') {
                   3726:               unless ($showsurv) {
                   3727:                   my $id = join(',',@parts);
                   3728:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3729:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3730:                       $lasthidden{$ign.'.'.$id} = 1;
                   3731:                   }
1.945     raeburn  3732:               }
1.1010    www      3733:           } 
1.31      albertel 3734: 	} else {
1.41      ng       3735: 	  if ($#parts == 0) {
                   3736: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3737: 	  } else {
                   3738: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3739: 	  }
1.31      albertel 3740: 	}
1.16      harris41 3741:       }
1.596     albertel 3742:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3743:       if ($getattempt eq '') {
                   3744: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3745:             my @hidden;
                   3746:             if (%typeparts) {
                   3747:                 foreach my $id (keys(%typeparts)) {
                   3748:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3749:                         push(@hidden,$id);
                   3750:                     }
                   3751:                 }
                   3752:             }
                   3753:             $prevattempts.=&start_data_table_row().
                   3754:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3755:             if (@hidden) {
                   3756:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3757:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3758:                     my $hide;
                   3759:                     foreach my $id (@hidden) {
                   3760:                         if ($key =~ /^\Q$id\E/) {
                   3761:                             $hide = 1;
                   3762:                             last;
                   3763:                         }
                   3764:                     }
                   3765:                     if ($hide) {
                   3766:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3767:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3768:                             my $value = &format_previous_attempt_value($key,
                   3769:                                              $returnhash{$version.':'.$key});
                   3770:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3771:                         } else {
                   3772:                             $prevattempts.='<td>&nbsp;</td>';
                   3773:                         }
                   3774:                     } else {
                   3775:                         if ($key =~ /\./) {
                   3776:                             my $value = &format_previous_attempt_value($key,
                   3777:                                               $returnhash{$version.':'.$key});
                   3778:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3779:                         } else {
                   3780:                             $prevattempts.='<td>&nbsp;</td>';
                   3781:                         }
                   3782:                     }
                   3783:                 }
                   3784:             } else {
                   3785: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3786:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3787: 		    my $value = &format_previous_attempt_value($key,
                   3788: 			            $returnhash{$version.':'.$key});
                   3789: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3790: 	        }
                   3791:             }
                   3792: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3793: 	 }
1.1       albertel 3794:       }
1.945     raeburn  3795:       my @currhidden = keys(%lasthidden);
1.596     albertel 3796:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3797:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3798:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3799:           if (%typeparts) {
                   3800:               my $hidden;
                   3801:               foreach my $id (@currhidden) {
                   3802:                   if ($key =~ /^\Q$id\E/) {
                   3803:                       $hidden = 1;
                   3804:                       last;
                   3805:                   }
                   3806:               }
                   3807:               if ($hidden) {
                   3808:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3809:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3810:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3811:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3812:                           $value = &$gradesub($value);
                   3813:                       }
                   3814:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3815:                   } else {
                   3816:                       $prevattempts.='<td>&nbsp;</td>';
                   3817:                   }
                   3818:               } else {
                   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:               }
                   3825:           } else {
                   3826: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3827: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3828:                   $value = &$gradesub($value);
                   3829:               }
                   3830: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3831:           }
1.16      harris41 3832:       }
1.596     albertel 3833:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3834:     } else {
1.596     albertel 3835:       $prevattempts=
                   3836: 	  &start_data_table().&start_data_table_row().
                   3837: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3838: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3839:     }
                   3840:   } else {
1.596     albertel 3841:     $prevattempts=
                   3842: 	  &start_data_table().&start_data_table_row().
                   3843: 	  '<td>'.&mt('No data.').'</td>'.
                   3844: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3845:   }
1.10      albertel 3846: }
                   3847: 
1.581     albertel 3848: sub format_previous_attempt_value {
                   3849:     my ($key,$value) = @_;
1.1011    www      3850:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3851: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3852:     } elsif (ref($value) eq 'ARRAY') {
                   3853: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3854:     } elsif ($key =~ /answerstring$/) {
                   3855:         my %answers = &Apache::lonnet::str2hash($value);
                   3856:         my @anskeys = sort(keys(%answers));
                   3857:         if (@anskeys == 1) {
                   3858:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3859:             if ($answer =~ m{\0}) {
                   3860:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3861:             }
                   3862:             my $tag_internal_answer_name = 'INTERNAL';
                   3863:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3864:                 $value = $answer; 
                   3865:             } else {
                   3866:                 $value = $anskeys[0].'='.$answer;
                   3867:             }
                   3868:         } else {
                   3869:             foreach my $ans (@anskeys) {
                   3870:                 my $answer = $answers{$ans};
1.1001    raeburn  3871:                 if ($answer =~ m{\0}) {
                   3872:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3873:                 }
                   3874:                 $value .=  $ans.'='.$answer.'<br />';;
                   3875:             } 
                   3876:         }
1.581     albertel 3877:     } else {
                   3878: 	$value = &unescape($value);
                   3879:     }
                   3880:     return $value;
                   3881: }
                   3882: 
                   3883: 
1.107     albertel 3884: sub relative_to_absolute {
                   3885:     my ($url,$output)=@_;
                   3886:     my $parser=HTML::TokeParser->new(\$output);
                   3887:     my $token;
                   3888:     my $thisdir=$url;
                   3889:     my @rlinks=();
                   3890:     while ($token=$parser->get_token) {
                   3891: 	if ($token->[0] eq 'S') {
                   3892: 	    if ($token->[1] eq 'a') {
                   3893: 		if ($token->[2]->{'href'}) {
                   3894: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3895: 		}
                   3896: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3897: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3898: 	    } elsif ($token->[1] eq 'base') {
                   3899: 		$thisdir=$token->[2]->{'href'};
                   3900: 	    }
                   3901: 	}
                   3902:     }
                   3903:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3904:     foreach my $link (@rlinks) {
1.726     raeburn  3905: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3906: 		($link=~/^\//) ||
                   3907: 		($link=~/^javascript:/i) ||
                   3908: 		($link=~/^mailto:/i) ||
                   3909: 		($link=~/^\#/)) {
                   3910: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3911: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3912: 	}
                   3913:     }
                   3914: # -------------------------------------------------- Deal with Applet codebases
                   3915:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3916:     return $output;
                   3917: }
                   3918: 
1.112     bowersj2 3919: =pod
                   3920: 
1.648     raeburn  3921: =item * &get_student_view()
1.112     bowersj2 3922: 
                   3923: show a snapshot of what student was looking at
                   3924: 
                   3925: =cut
                   3926: 
1.10      albertel 3927: sub get_student_view {
1.186     albertel 3928:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3929:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3930:   my (%form);
1.10      albertel 3931:   my @elements=('symb','courseid','domain','username');
                   3932:   foreach my $element (@elements) {
1.186     albertel 3933:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3934:   }
1.186     albertel 3935:   if (defined($moreenv)) {
                   3936:       %form=(%form,%{$moreenv});
                   3937:   }
1.236     albertel 3938:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3939:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3940:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3941:   $userview=~s/\<body[^\>]*\>//gi;
                   3942:   $userview=~s/\<\/body\>//gi;
                   3943:   $userview=~s/\<html\>//gi;
                   3944:   $userview=~s/\<\/html\>//gi;
                   3945:   $userview=~s/\<head\>//gi;
                   3946:   $userview=~s/\<\/head\>//gi;
                   3947:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3948:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3949:   if (wantarray) {
                   3950:      return ($userview,$response);
                   3951:   } else {
                   3952:      return $userview;
                   3953:   }
                   3954: }
                   3955: 
                   3956: sub get_student_view_with_retries {
                   3957:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3958: 
                   3959:     my $ok = 0;                 # True if we got a good response.
                   3960:     my $content;
                   3961:     my $response;
                   3962: 
                   3963:     # Try to get the student_view done. within the retries count:
                   3964:     
                   3965:     do {
                   3966:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3967:          $ok      = $response->is_success;
                   3968:          if (!$ok) {
                   3969:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3970:          }
                   3971:          $retries--;
                   3972:     } while (!$ok && ($retries > 0));
                   3973:     
                   3974:     if (!$ok) {
                   3975:        $content = '';          # On error return an empty content.
                   3976:     }
1.651     www      3977:     if (wantarray) {
                   3978:        return ($content, $response);
                   3979:     } else {
                   3980:        return $content;
                   3981:     }
1.11      albertel 3982: }
                   3983: 
1.112     bowersj2 3984: =pod
                   3985: 
1.648     raeburn  3986: =item * &get_student_answers() 
1.112     bowersj2 3987: 
                   3988: show a snapshot of how student was answering problem
                   3989: 
                   3990: =cut
                   3991: 
1.11      albertel 3992: sub get_student_answers {
1.100     sakharuk 3993:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      3994:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3995:   my (%moreenv);
1.11      albertel 3996:   my @elements=('symb','courseid','domain','username');
                   3997:   foreach my $element (@elements) {
1.186     albertel 3998:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3999:   }
1.186     albertel 4000:   $moreenv{'grade_target'}='answer';
                   4001:   %moreenv=(%form,%moreenv);
1.497     raeburn  4002:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4003:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4004:   return $userview;
1.1       albertel 4005: }
1.116     albertel 4006: 
                   4007: =pod
                   4008: 
                   4009: =item * &submlink()
                   4010: 
1.242     albertel 4011: Inputs: $text $uname $udom $symb $target
1.116     albertel 4012: 
                   4013: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4014: 
                   4015: =cut
                   4016: 
                   4017: ###############################################
                   4018: sub submlink {
1.242     albertel 4019:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4020:     if (!($uname && $udom)) {
                   4021: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4022: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4023: 	if (!$symb) { $symb=$cursymb; }
                   4024:     }
1.254     matthew  4025:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4026:     $symb=&escape($symb);
1.960     bisitz   4027:     if ($target) { $target=" target=\"$target\""; }
                   4028:     return
                   4029:         '<a href="/adm/grades?command=submission'.
                   4030:         '&amp;symb='.$symb.
                   4031:         '&amp;student='.$uname.
                   4032:         '&amp;userdom='.$udom.'"'.
                   4033:         $target.'>'.$text.'</a>';
1.242     albertel 4034: }
                   4035: ##############################################
                   4036: 
                   4037: =pod
                   4038: 
                   4039: =item * &pgrdlink()
                   4040: 
                   4041: Inputs: $text $uname $udom $symb $target
                   4042: 
                   4043: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4044: 
                   4045: =cut
                   4046: 
                   4047: ###############################################
                   4048: sub pgrdlink {
                   4049:     my $link=&submlink(@_);
                   4050:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4051:     return $link;
                   4052: }
                   4053: ##############################################
                   4054: 
                   4055: =pod
                   4056: 
                   4057: =item * &pprmlink()
                   4058: 
                   4059: Inputs: $text $uname $udom $symb $target
                   4060: 
                   4061: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4062: student and a specific resource
1.242     albertel 4063: 
                   4064: =cut
                   4065: 
                   4066: ###############################################
                   4067: sub pprmlink {
                   4068:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4069:     if (!($uname && $udom)) {
                   4070: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4071: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4072: 	if (!$symb) { $symb=$cursymb; }
                   4073:     }
1.254     matthew  4074:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4075:     $symb=&escape($symb);
1.242     albertel 4076:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4077:     return '<a href="/adm/parmset?command=set&amp;'.
                   4078: 	'symb='.$symb.'&amp;uname='.$uname.
                   4079: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4080: }
                   4081: ##############################################
1.37      matthew  4082: 
1.112     bowersj2 4083: =pod
                   4084: 
                   4085: =back
                   4086: 
                   4087: =cut
                   4088: 
1.37      matthew  4089: ###############################################
1.51      www      4090: 
                   4091: 
                   4092: sub timehash {
1.687     raeburn  4093:     my ($thistime) = @_;
                   4094:     my $timezone = &Apache::lonlocal::gettimezone();
                   4095:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4096:                      ->set_time_zone($timezone);
                   4097:     my $wday = $dt->day_of_week();
                   4098:     if ($wday == 7) { $wday = 0; }
                   4099:     return ( 'second' => $dt->second(),
                   4100:              'minute' => $dt->minute(),
                   4101:              'hour'   => $dt->hour(),
                   4102:              'day'     => $dt->day_of_month(),
                   4103:              'month'   => $dt->month(),
                   4104:              'year'    => $dt->year(),
                   4105:              'weekday' => $wday,
                   4106:              'dayyear' => $dt->day_of_year(),
                   4107:              'dlsav'   => $dt->is_dst() );
1.51      www      4108: }
                   4109: 
1.370     www      4110: sub utc_string {
                   4111:     my ($date)=@_;
1.371     www      4112:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4113: }
                   4114: 
1.51      www      4115: sub maketime {
                   4116:     my %th=@_;
1.687     raeburn  4117:     my ($epoch_time,$timezone,$dt);
                   4118:     $timezone = &Apache::lonlocal::gettimezone();
                   4119:     eval {
                   4120:         $dt = DateTime->new( year   => $th{'year'},
                   4121:                              month  => $th{'month'},
                   4122:                              day    => $th{'day'},
                   4123:                              hour   => $th{'hour'},
                   4124:                              minute => $th{'minute'},
                   4125:                              second => $th{'second'},
                   4126:                              time_zone => $timezone,
                   4127:                          );
                   4128:     };
                   4129:     if (!$@) {
                   4130:         $epoch_time = $dt->epoch;
                   4131:         if ($epoch_time) {
                   4132:             return $epoch_time;
                   4133:         }
                   4134:     }
1.51      www      4135:     return POSIX::mktime(
                   4136:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4137:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4138: }
                   4139: 
                   4140: #########################################
1.51      www      4141: 
                   4142: sub findallcourses {
1.482     raeburn  4143:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4144:     my %roles;
                   4145:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4146:     my %courses;
1.51      www      4147:     my $now=time;
1.482     raeburn  4148:     if (!defined($uname)) {
                   4149:         $uname = $env{'user.name'};
                   4150:     }
                   4151:     if (!defined($udom)) {
                   4152:         $udom = $env{'user.domain'};
                   4153:     }
                   4154:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4155:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4156:         if (!%roles) {
                   4157:             %roles = (
                   4158:                        cc => 1,
1.907     raeburn  4159:                        co => 1,
1.482     raeburn  4160:                        in => 1,
                   4161:                        ep => 1,
                   4162:                        ta => 1,
                   4163:                        cr => 1,
                   4164:                        st => 1,
                   4165:              );
                   4166:         }
                   4167:         foreach my $entry (keys(%roleshash)) {
                   4168:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4169:             if ($trole =~ /^cr/) { 
                   4170:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4171:             } else {
                   4172:                 next if (!exists($roles{$trole}));
                   4173:             }
                   4174:             if ($tend) {
                   4175:                 next if ($tend < $now);
                   4176:             }
                   4177:             if ($tstart) {
                   4178:                 next if ($tstart > $now);
                   4179:             }
1.1058    raeburn  4180:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4181:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4182:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4183:             if ($secpart eq '') {
                   4184:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4185:                 $sec = 'none';
1.1058    raeburn  4186:                 $value .= $cnum.'/';
1.482     raeburn  4187:             } else {
                   4188:                 $cnum = $cnumpart;
                   4189:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4190:                 $value .= $cnum.'/'.$sec;
                   4191:             }
                   4192:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4193:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4194:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4195:                 }
                   4196:             } else {
                   4197:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4198:             }
1.482     raeburn  4199:         }
                   4200:     } else {
                   4201:         foreach my $key (keys(%env)) {
1.483     albertel 4202: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4203:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4204: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4205: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4206: 	        next if (%roles && !exists($roles{$role}));
                   4207: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4208:                 my $active=1;
                   4209:                 if ($starttime) {
                   4210: 		    if ($now<$starttime) { $active=0; }
                   4211:                 }
                   4212:                 if ($endtime) {
                   4213:                     if ($now>$endtime) { $active=0; }
                   4214:                 }
                   4215:                 if ($active) {
1.1058    raeburn  4216:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4217:                     if ($sec eq '') {
                   4218:                         $sec = 'none';
1.1058    raeburn  4219:                     } else {
                   4220:                         $value .= $sec;
                   4221:                     }
                   4222:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4223:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4224:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4225:                         }
                   4226:                     } else {
                   4227:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4228:                     }
1.474     raeburn  4229:                 }
                   4230:             }
1.51      www      4231:         }
                   4232:     }
1.474     raeburn  4233:     return %courses;
1.51      www      4234: }
1.37      matthew  4235: 
1.54      www      4236: ###############################################
1.474     raeburn  4237: 
                   4238: sub blockcheck {
1.1075.2.73  raeburn  4239:     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490     raeburn  4240: 
1.1075.2.73  raeburn  4241:     if (defined($udom) && defined($uname)) {
                   4242:         # If uname and udom are for a course, check for blocks in the course.
                   4243:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4244:             my ($startblock,$endblock,$triggerblock) =
                   4245:                 &get_blocks($setters,$activity,$udom,$uname,$url);
                   4246:             return ($startblock,$endblock,$triggerblock);
                   4247:         }
                   4248:     } else {
1.490     raeburn  4249:         $udom = $env{'user.domain'};
                   4250:         $uname = $env{'user.name'};
                   4251:     }
                   4252: 
1.502     raeburn  4253:     my $startblock = 0;
                   4254:     my $endblock = 0;
1.1062    raeburn  4255:     my $triggerblock = '';
1.482     raeburn  4256:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4257: 
1.490     raeburn  4258:     # If uname is for a user, and activity is course-specific, i.e.,
                   4259:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4260: 
1.490     raeburn  4261:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73  raeburn  4262:          $activity eq 'groups' || $activity eq 'printout') &&
                   4263:         ($env{'request.course.id'})) {
1.490     raeburn  4264:         foreach my $key (keys(%live_courses)) {
                   4265:             if ($key ne $env{'request.course.id'}) {
                   4266:                 delete($live_courses{$key});
                   4267:             }
                   4268:         }
                   4269:     }
                   4270: 
                   4271:     my $otheruser = 0;
                   4272:     my %own_courses;
                   4273:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4274:         # Resource belongs to user other than current user.
                   4275:         $otheruser = 1;
                   4276:         # Gather courses for current user
                   4277:         %own_courses = 
                   4278:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4279:     }
                   4280: 
                   4281:     # Gather active course roles - course coordinator, instructor, 
                   4282:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4283: 
                   4284:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4285:         my ($cdom,$cnum);
                   4286:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4287:             $cdom = $env{'course.'.$course.'.domain'};
                   4288:             $cnum = $env{'course.'.$course.'.num'};
                   4289:         } else {
1.490     raeburn  4290:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4291:         }
                   4292:         my $no_ownblock = 0;
                   4293:         my $no_userblock = 0;
1.533     raeburn  4294:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4295:             # Check if current user has 'evb' priv for this
                   4296:             if (defined($own_courses{$course})) {
                   4297:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4298:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4299:                     if ($sec ne 'none') {
                   4300:                         $checkrole .= '/'.$sec;
                   4301:                     }
                   4302:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4303:                         $no_ownblock = 1;
                   4304:                         last;
                   4305:                     }
                   4306:                 }
                   4307:             }
                   4308:             # if they have 'evb' priv and are currently not playing student
                   4309:             next if (($no_ownblock) &&
                   4310:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4311:         }
1.474     raeburn  4312:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4313:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4314:             if ($sec ne 'none') {
1.482     raeburn  4315:                 $checkrole .= '/'.$sec;
1.474     raeburn  4316:             }
1.490     raeburn  4317:             if ($otheruser) {
                   4318:                 # Resource belongs to user other than current user.
                   4319:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4320:                 my (%allroles,%userroles);
                   4321:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4322:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4323:                         my ($trole,$tdom,$tnum,$tsec);
                   4324:                         if ($entry =~ /^cr/) {
                   4325:                             ($trole,$tdom,$tnum,$tsec) = 
                   4326:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4327:                         } else {
                   4328:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4329:                         }
                   4330:                         my ($spec,$area,$trest);
                   4331:                         $area = '/'.$tdom.'/'.$tnum;
                   4332:                         $trest = $tnum;
                   4333:                         if ($tsec ne '') {
                   4334:                             $area .= '/'.$tsec;
                   4335:                             $trest .= '/'.$tsec;
                   4336:                         }
                   4337:                         $spec = $trole.'.'.$area;
                   4338:                         if ($trole =~ /^cr/) {
                   4339:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4340:                                                               $tdom,$spec,$trest,$area);
                   4341:                         } else {
                   4342:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4343:                                                                 $tdom,$spec,$trest,$area);
                   4344:                         }
                   4345:                     }
                   4346:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4347:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4348:                         if ($1) {
                   4349:                             $no_userblock = 1;
                   4350:                             last;
                   4351:                         }
1.486     raeburn  4352:                     }
                   4353:                 }
1.490     raeburn  4354:             } else {
                   4355:                 # Resource belongs to current user
                   4356:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4357:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4358:                     $no_ownblock = 1;
                   4359:                     last;
                   4360:                 }
1.474     raeburn  4361:             }
                   4362:         }
                   4363:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4364:         next if (($no_ownblock) &&
1.491     albertel 4365:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4366:         next if ($no_userblock);
1.474     raeburn  4367: 
1.866     kalberla 4368:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4369:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4370:         
1.1062    raeburn  4371:         my ($start,$end,$trigger) = 
                   4372:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4373:         if (($start != 0) && 
                   4374:             (($startblock == 0) || ($startblock > $start))) {
                   4375:             $startblock = $start;
1.1062    raeburn  4376:             if ($trigger ne '') {
                   4377:                 $triggerblock = $trigger;
                   4378:             }
1.502     raeburn  4379:         }
                   4380:         if (($end != 0)  &&
                   4381:             (($endblock == 0) || ($endblock < $end))) {
                   4382:             $endblock = $end;
1.1062    raeburn  4383:             if ($trigger ne '') {
                   4384:                 $triggerblock = $trigger;
                   4385:             }
1.502     raeburn  4386:         }
1.490     raeburn  4387:     }
1.1062    raeburn  4388:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4389: }
                   4390: 
                   4391: sub get_blocks {
1.1062    raeburn  4392:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4393:     my $startblock = 0;
                   4394:     my $endblock = 0;
1.1062    raeburn  4395:     my $triggerblock = '';
1.490     raeburn  4396:     my $course = $cdom.'_'.$cnum;
                   4397:     $setters->{$course} = {};
                   4398:     $setters->{$course}{'staff'} = [];
                   4399:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4400:     $setters->{$course}{'triggers'} = [];
                   4401:     my (@blockers,%triggered);
                   4402:     my $now = time;
                   4403:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4404:     if ($activity eq 'docs') {
                   4405:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4406:         foreach my $block (@blockers) {
                   4407:             if ($block =~ /^firstaccess____(.+)$/) {
                   4408:                 my $item = $1;
                   4409:                 my $type = 'map';
                   4410:                 my $timersymb = $item;
                   4411:                 if ($item eq 'course') {
                   4412:                     $type = 'course';
                   4413:                 } elsif ($item =~ /___\d+___/) {
                   4414:                     $type = 'resource';
                   4415:                 } else {
                   4416:                     $timersymb = &Apache::lonnet::symbread($item);
                   4417:                 }
                   4418:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4419:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4420:                 $triggered{$block} = {
                   4421:                                        start => $start,
                   4422:                                        end   => $end,
                   4423:                                        type  => $type,
                   4424:                                      };
                   4425:             }
                   4426:         }
                   4427:     } else {
                   4428:         foreach my $block (keys(%commblocks)) {
                   4429:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4430:                 my ($start,$end) = ($1,$2);
                   4431:                 if ($start <= time && $end >= time) {
                   4432:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4433:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4434:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4435:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4436:                                     push(@blockers,$block);
                   4437:                                 }
                   4438:                             }
                   4439:                         }
                   4440:                     }
                   4441:                 }
                   4442:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4443:                 my $item = $1;
                   4444:                 my $timersymb = $item; 
                   4445:                 my $type = 'map';
                   4446:                 if ($item eq 'course') {
                   4447:                     $type = 'course';
                   4448:                 } elsif ($item =~ /___\d+___/) {
                   4449:                     $type = 'resource';
                   4450:                 } else {
                   4451:                     $timersymb = &Apache::lonnet::symbread($item);
                   4452:                 }
                   4453:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4454:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4455:                 if ($start && $end) {
                   4456:                     if (($start <= time) && ($end >= time)) {
                   4457:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4458:                             push(@blockers,$block);
                   4459:                             $triggered{$block} = {
                   4460:                                                    start => $start,
                   4461:                                                    end   => $end,
                   4462:                                                    type  => $type,
                   4463:                                                  };
                   4464:                         }
                   4465:                     }
1.490     raeburn  4466:                 }
1.1062    raeburn  4467:             }
                   4468:         }
                   4469:     }
                   4470:     foreach my $blocker (@blockers) {
                   4471:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4472:             &parse_block_record($commblocks{$blocker});
                   4473:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4474:         my ($start,$end,$triggertype);
                   4475:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4476:             ($start,$end) = ($1,$2);
                   4477:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4478:             $start = $triggered{$blocker}{'start'};
                   4479:             $end = $triggered{$blocker}{'end'};
                   4480:             $triggertype = $triggered{$blocker}{'type'};
                   4481:         }
                   4482:         if ($start) {
                   4483:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4484:             if ($triggertype) {
                   4485:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4486:             } else {
                   4487:                 push(@{$$setters{$course}{'triggers'}},0);
                   4488:             }
                   4489:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4490:                 $startblock = $start;
                   4491:                 if ($triggertype) {
                   4492:                     $triggerblock = $blocker;
1.474     raeburn  4493:                 }
                   4494:             }
1.1062    raeburn  4495:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4496:                $endblock = $end;
                   4497:                if ($triggertype) {
                   4498:                    $triggerblock = $blocker;
                   4499:                }
                   4500:             }
1.474     raeburn  4501:         }
                   4502:     }
1.1062    raeburn  4503:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4504: }
                   4505: 
                   4506: sub parse_block_record {
                   4507:     my ($record) = @_;
                   4508:     my ($setuname,$setudom,$title,$blocks);
                   4509:     if (ref($record) eq 'HASH') {
                   4510:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4511:         $title = &unescape($record->{'event'});
                   4512:         $blocks = $record->{'blocks'};
                   4513:     } else {
                   4514:         my @data = split(/:/,$record,3);
                   4515:         if (scalar(@data) eq 2) {
                   4516:             $title = $data[1];
                   4517:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4518:         } else {
                   4519:             ($setuname,$setudom,$title) = @data;
                   4520:         }
                   4521:         $blocks = { 'com' => 'on' };
                   4522:     }
                   4523:     return ($setuname,$setudom,$title,$blocks);
                   4524: }
                   4525: 
1.854     kalberla 4526: sub blocking_status {
1.1075.2.73  raeburn  4527:     my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061    raeburn  4528:     my %setters;
1.890     droeschl 4529: 
1.1061    raeburn  4530: # check for active blocking
1.1062    raeburn  4531:     my ($startblock,$endblock,$triggerblock) = 
1.1075.2.73  raeburn  4532:         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062    raeburn  4533:     my $blocked = 0;
                   4534:     if ($startblock && $endblock) {
                   4535:         $blocked = 1;
                   4536:     }
1.890     droeschl 4537: 
1.1061    raeburn  4538: # caller just wants to know whether a block is active
                   4539:     if (!wantarray) { return $blocked; }
                   4540: 
                   4541: # build a link to a popup window containing the details
                   4542:     my $querystring  = "?activity=$activity";
                   4543: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4544:     if ($activity eq 'port') {
                   4545:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4546:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4547:     } elsif ($activity eq 'docs') {
                   4548:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4549:     }
1.1061    raeburn  4550: 
                   4551:     my $output .= <<'END_MYBLOCK';
                   4552: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4553:     var options = "width=" + w + ",height=" + h + ",";
                   4554:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4555:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4556:     var newWin = window.open(url, wdwName, options);
                   4557:     newWin.focus();
                   4558: }
1.890     droeschl 4559: END_MYBLOCK
1.854     kalberla 4560: 
1.1061    raeburn  4561:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4562:   
1.1061    raeburn  4563:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4564:     my $text = &mt('Communication Blocked');
                   4565:     if ($activity eq 'docs') {
                   4566:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4567:     } elsif ($activity eq 'printout') {
                   4568:         $text = &mt('Printing Blocked');
1.1062    raeburn  4569:     }
1.1061    raeburn  4570:     $output .= <<"END_BLOCK";
1.867     kalberla 4571: <div class='LC_comblock'>
1.869     kalberla 4572:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4573:   title='$text'>
                   4574:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4575:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4576:   title='$text'>$text</a>
1.867     kalberla 4577: </div>
                   4578: 
                   4579: END_BLOCK
1.474     raeburn  4580: 
1.1061    raeburn  4581:     return ($blocked, $output);
1.854     kalberla 4582: }
1.490     raeburn  4583: 
1.60      matthew  4584: ###############################################
                   4585: 
1.682     raeburn  4586: sub check_ip_acc {
                   4587:     my ($acc)=@_;
                   4588:     &Apache::lonxml::debug("acc is $acc");
                   4589:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4590:         return 1;
                   4591:     }
                   4592:     my $allowed=0;
                   4593:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4594: 
                   4595:     my $name;
                   4596:     foreach my $pattern (split(',',$acc)) {
                   4597:         $pattern =~ s/^\s*//;
                   4598:         $pattern =~ s/\s*$//;
                   4599:         if ($pattern =~ /\*$/) {
                   4600:             #35.8.*
                   4601:             $pattern=~s/\*//;
                   4602:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4603:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4604:             #35.8.3.[34-56]
                   4605:             my $low=$2;
                   4606:             my $high=$3;
                   4607:             $pattern=$1;
                   4608:             if ($ip =~ /^\Q$pattern\E/) {
                   4609:                 my $last=(split(/\./,$ip))[3];
                   4610:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4611:             }
                   4612:         } elsif ($pattern =~ /^\*/) {
                   4613:             #*.msu.edu
                   4614:             $pattern=~s/\*//;
                   4615:             if (!defined($name)) {
                   4616:                 use Socket;
                   4617:                 my $netaddr=inet_aton($ip);
                   4618:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4619:             }
                   4620:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4621:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4622:             #127.0.0.1
                   4623:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4624:         } else {
                   4625:             #some.name.com
                   4626:             if (!defined($name)) {
                   4627:                 use Socket;
                   4628:                 my $netaddr=inet_aton($ip);
                   4629:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4630:             }
                   4631:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4632:         }
                   4633:         if ($allowed) { last; }
                   4634:     }
                   4635:     return $allowed;
                   4636: }
                   4637: 
                   4638: ###############################################
                   4639: 
1.60      matthew  4640: =pod
                   4641: 
1.112     bowersj2 4642: =head1 Domain Template Functions
                   4643: 
                   4644: =over 4
                   4645: 
                   4646: =item * &determinedomain()
1.60      matthew  4647: 
                   4648: Inputs: $domain (usually will be undef)
                   4649: 
1.63      www      4650: Returns: Determines which domain should be used for designs
1.60      matthew  4651: 
                   4652: =cut
1.54      www      4653: 
1.60      matthew  4654: ###############################################
1.63      www      4655: sub determinedomain {
                   4656:     my $domain=shift;
1.531     albertel 4657:     if (! $domain) {
1.60      matthew  4658:         # Determine domain if we have not been given one
1.893     raeburn  4659:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4660:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4661:         if ($env{'request.role.domain'}) { 
                   4662:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4663:         }
                   4664:     }
1.63      www      4665:     return $domain;
                   4666: }
                   4667: ###############################################
1.517     raeburn  4668: 
1.518     albertel 4669: sub devalidate_domconfig_cache {
                   4670:     my ($udom)=@_;
                   4671:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4672: }
                   4673: 
                   4674: # ---------------------- Get domain configuration for a domain
                   4675: sub get_domainconf {
                   4676:     my ($udom) = @_;
                   4677:     my $cachetime=1800;
                   4678:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4679:     if (defined($cached)) { return %{$result}; }
                   4680: 
                   4681:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4682: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4683:     my (%designhash,%legacy);
1.518     albertel 4684:     if (keys(%domconfig) > 0) {
                   4685:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4686:             if (keys(%{$domconfig{'login'}})) {
                   4687:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4688:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4689:                         if ($key eq 'loginvia') {
                   4690:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4691:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4692:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4693:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4694:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4695:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4696:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4697: 
                   4698:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4699:                                             } else {
1.1013    raeburn  4700:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4701:                                             }
                   4702:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4703:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4704:                                             }
1.946     raeburn  4705:                                         }
                   4706:                                     }
                   4707:                                 }
                   4708:                             }
                   4709:                         } else {
                   4710:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4711:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4712:                                     $domconfig{'login'}{$key}{$img};
                   4713:                             }
1.699     raeburn  4714:                         }
                   4715:                     } else {
                   4716:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4717:                     }
1.632     raeburn  4718:                 }
                   4719:             } else {
                   4720:                 $legacy{'login'} = 1;
1.518     albertel 4721:             }
1.632     raeburn  4722:         } else {
                   4723:             $legacy{'login'} = 1;
1.518     albertel 4724:         }
                   4725:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4726:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4727:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4728:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4729:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4730:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4731:                         }
1.518     albertel 4732:                     }
                   4733:                 }
1.632     raeburn  4734:             } else {
                   4735:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4736:             }
1.632     raeburn  4737:         } else {
                   4738:             $legacy{'rolecolors'} = 1;
1.518     albertel 4739:         }
1.948     raeburn  4740:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4741:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4742:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4743:             }
                   4744:         }
1.632     raeburn  4745:         if (keys(%legacy) > 0) {
                   4746:             my %legacyhash = &get_legacy_domconf($udom);
                   4747:             foreach my $item (keys(%legacyhash)) {
                   4748:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4749:                     if ($legacy{'login'}) { 
                   4750:                         $designhash{$item} = $legacyhash{$item};
                   4751:                     }
                   4752:                 } else {
                   4753:                     if ($legacy{'rolecolors'}) {
                   4754:                         $designhash{$item} = $legacyhash{$item};
                   4755:                     }
1.518     albertel 4756:                 }
                   4757:             }
                   4758:         }
1.632     raeburn  4759:     } else {
                   4760:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4761:     }
                   4762:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4763: 				  $cachetime);
                   4764:     return %designhash;
                   4765: }
                   4766: 
1.632     raeburn  4767: sub get_legacy_domconf {
                   4768:     my ($udom) = @_;
                   4769:     my %legacyhash;
                   4770:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4771:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4772:     if (-e $designfile) {
                   4773:         if ( open (my $fh,"<$designfile") ) {
                   4774:             while (my $line = <$fh>) {
                   4775:                 next if ($line =~ /^\#/);
                   4776:                 chomp($line);
                   4777:                 my ($key,$val)=(split(/\=/,$line));
                   4778:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4779:             }
                   4780:             close($fh);
                   4781:         }
                   4782:     }
1.1026    raeburn  4783:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4784:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4785:     }
                   4786:     return %legacyhash;
                   4787: }
                   4788: 
1.63      www      4789: =pod
                   4790: 
1.112     bowersj2 4791: =item * &domainlogo()
1.63      www      4792: 
                   4793: Inputs: $domain (usually will be undef)
                   4794: 
                   4795: Returns: A link to a domain logo, if the domain logo exists.
                   4796: If the domain logo does not exist, a description of the domain.
                   4797: 
                   4798: =cut
1.112     bowersj2 4799: 
1.63      www      4800: ###############################################
                   4801: sub domainlogo {
1.517     raeburn  4802:     my $domain = &determinedomain(shift);
1.518     albertel 4803:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4804:     # See if there is a logo
                   4805:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4806:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4807:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4808: 	    if ($imgsrc =~ m{^/res/}) {
                   4809: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4810: 		&Apache::lonnet::repcopy($local_name);
                   4811: 	    }
                   4812: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4813:         } 
                   4814:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4815:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4816:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4817:     } else {
1.60      matthew  4818:         return '';
1.59      www      4819:     }
                   4820: }
1.63      www      4821: ##############################################
                   4822: 
                   4823: =pod
                   4824: 
1.112     bowersj2 4825: =item * &designparm()
1.63      www      4826: 
                   4827: Inputs: $which parameter; $domain (usually will be undef)
                   4828: 
                   4829: Returns: value of designparamter $which
                   4830: 
                   4831: =cut
1.112     bowersj2 4832: 
1.397     albertel 4833: 
1.400     albertel 4834: ##############################################
1.397     albertel 4835: sub designparm {
                   4836:     my ($which,$domain)=@_;
                   4837:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4838:         return $env{'environment.color.'.$which};
1.96      www      4839:     }
1.63      www      4840:     $domain=&determinedomain($domain);
1.1016    raeburn  4841:     my %domdesign;
                   4842:     unless ($domain eq 'public') {
                   4843:         %domdesign = &get_domainconf($domain);
                   4844:     }
1.520     raeburn  4845:     my $output;
1.517     raeburn  4846:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4847:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4848:     } else {
1.520     raeburn  4849:         $output = $defaultdesign{$which};
                   4850:     }
                   4851:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4852:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4853:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4854:             if ($output =~ m{^/res/}) {
                   4855:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4856:                 &Apache::lonnet::repcopy($local_name);
                   4857:             }
1.520     raeburn  4858:             $output = &lonhttpdurl($output);
                   4859:         }
1.63      www      4860:     }
1.520     raeburn  4861:     return $output;
1.63      www      4862: }
1.59      www      4863: 
1.822     bisitz   4864: ##############################################
                   4865: =pod
                   4866: 
1.832     bisitz   4867: =item * &authorspace()
                   4868: 
1.1028    raeburn  4869: Inputs: $url (usually will be undef).
1.832     bisitz   4870: 
1.1075.2.40  raeburn  4871: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  4872:          directory being viewed (or for which action is being taken). 
                   4873:          If $url is provided, and begins /priv/<domain>/<uname>
                   4874:          the path will be that portion of the $context argument.
                   4875:          Otherwise the path will be for the author space of the current
                   4876:          user when the current role is author, or for that of the 
                   4877:          co-author/assistant co-author space when the current role 
                   4878:          is co-author or assistant co-author.
1.832     bisitz   4879: 
                   4880: =cut
                   4881: 
                   4882: sub authorspace {
1.1028    raeburn  4883:     my ($url) = @_;
                   4884:     if ($url ne '') {
                   4885:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4886:            return $1;
                   4887:         }
                   4888:     }
1.832     bisitz   4889:     my $caname = '';
1.1024    www      4890:     my $cadom = '';
1.1028    raeburn  4891:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4892:         ($cadom,$caname) =
1.832     bisitz   4893:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4894:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4895:         $caname = $env{'user.name'};
1.1024    www      4896:         $cadom = $env{'user.domain'};
1.832     bisitz   4897:     }
1.1028    raeburn  4898:     if (($caname ne '') && ($cadom ne '')) {
                   4899:         return "/priv/$cadom/$caname/";
                   4900:     }
                   4901:     return;
1.832     bisitz   4902: }
                   4903: 
                   4904: ##############################################
                   4905: =pod
                   4906: 
1.822     bisitz   4907: =item * &head_subbox()
                   4908: 
                   4909: Inputs: $content (contains HTML code with page functions, etc.)
                   4910: 
                   4911: Returns: HTML div with $content
                   4912:          To be included in page header
                   4913: 
                   4914: =cut
                   4915: 
                   4916: sub head_subbox {
                   4917:     my ($content)=@_;
                   4918:     my $output =
1.993     raeburn  4919:         '<div class="LC_head_subbox">'
1.822     bisitz   4920:        .$content
                   4921:        .'</div>'
                   4922: }
                   4923: 
                   4924: ##############################################
                   4925: =pod
                   4926: 
                   4927: =item * &CSTR_pageheader()
                   4928: 
1.1026    raeburn  4929: Input: (optional) filename from which breadcrumb trail is built.
                   4930:        In most cases no input as needed, as $env{'request.filename'}
                   4931:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4932: 
                   4933: Returns: HTML div with CSTR path and recent box
1.1075.2.40  raeburn  4934:          To be included on Authoring Space pages
1.822     bisitz   4935: 
                   4936: =cut
                   4937: 
                   4938: sub CSTR_pageheader {
1.1026    raeburn  4939:     my ($trailfile) = @_;
                   4940:     if ($trailfile eq '') {
                   4941:         $trailfile = $env{'request.filename'};
                   4942:     }
                   4943: 
                   4944: # this is for resources; directories have customtitle, and crumbs
                   4945: # and select recent are created in lonpubdir.pm
                   4946: 
                   4947:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4948:     my ($udom,$uname,$thisdisfn)=
1.1075.2.29  raeburn  4949:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  4950:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4951:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4952: 
                   4953:     my $parentpath = '';
                   4954:     my $lastitem = '';
                   4955:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4956:         $parentpath = $1;
                   4957:         $lastitem = $2;
                   4958:     } else {
                   4959:         $lastitem = $thisdisfn;
                   4960:     }
1.921     bisitz   4961: 
                   4962:     my $output =
1.822     bisitz   4963:          '<div>'
                   4964:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40  raeburn  4965:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   4966:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4967:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4968:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4969: 
                   4970:     if ($lastitem) {
                   4971:         $output .=
                   4972:              '<span class="LC_filename">'
                   4973:             .$lastitem
                   4974:             .'</span>';
                   4975:     }
                   4976:     $output .=
                   4977:          '<br />'
1.822     bisitz   4978:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4979:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4980:         .'</form>'
                   4981:         .&Apache::lonmenu::constspaceform()
                   4982:         .'</div>';
1.921     bisitz   4983: 
                   4984:     return $output;
1.822     bisitz   4985: }
                   4986: 
1.60      matthew  4987: ###############################################
                   4988: ###############################################
                   4989: 
                   4990: =pod
                   4991: 
1.112     bowersj2 4992: =back
                   4993: 
1.549     albertel 4994: =head1 HTML Helpers
1.112     bowersj2 4995: 
                   4996: =over 4
                   4997: 
                   4998: =item * &bodytag()
1.60      matthew  4999: 
                   5000: Returns a uniform header for LON-CAPA web pages.
                   5001: 
                   5002: Inputs: 
                   5003: 
1.112     bowersj2 5004: =over 4
                   5005: 
                   5006: =item * $title, A title to be displayed on the page.
                   5007: 
                   5008: =item * $function, the current role (can be undef).
                   5009: 
                   5010: =item * $addentries, extra parameters for the <body> tag.
                   5011: 
                   5012: =item * $bodyonly, if defined, only return the <body> tag.
                   5013: 
                   5014: =item * $domain, if defined, force a given domain.
                   5015: 
                   5016: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5017:             text interface only)
1.60      matthew  5018: 
1.814     bisitz   5019: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5020:                      navigational links
1.317     albertel 5021: 
1.338     albertel 5022: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5023: 
1.1075.2.12  raeburn  5024: =item * $no_inline_link, if true and in remote mode, don't show the
                   5025:          'Switch To Inline Menu' link
                   5026: 
1.460     albertel 5027: =item * $args, optional argument valid values are
                   5028:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5029:             inherit_jsmath -> when creating popup window in a page,
                   5030:                               should it have jsmath forced on by the
                   5031:                               current page
1.460     albertel 5032: 
1.1075.2.15  raeburn  5033: =item * $advtoolsref, optional argument, ref to an array containing
                   5034:             inlineremote items to be added in "Functions" menu below
                   5035:             breadcrumbs.
                   5036: 
1.112     bowersj2 5037: =back
                   5038: 
1.60      matthew  5039: Returns: A uniform header for LON-CAPA web pages.  
                   5040: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5041: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5042: other decorations will be returned.
                   5043: 
                   5044: =cut
                   5045: 
1.54      www      5046: sub bodytag {
1.831     bisitz   5047:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15  raeburn  5048:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 5049: 
1.954     raeburn  5050:     my $public;
                   5051:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5052:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5053:         $public = 1;
                   5054:     }
1.460     albertel 5055:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52  raeburn  5056:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5057: 
1.183     matthew  5058:     $function = &get_users_function() if (!$function);
1.339     albertel 5059:     my $img =    &designparm($function.'.img',$domain);
                   5060:     my $font =   &designparm($function.'.font',$domain);
                   5061:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5062: 
1.803     bisitz   5063:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5064: 		   'bgcolor' => $pgbg,
1.339     albertel 5065: 		   'text'    => $font,
                   5066:                    'alink'   => &designparm($function.'.alink',$domain),
                   5067: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5068: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5069:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5070: 
1.63      www      5071:  # role and realm
1.1075.2.68  raeburn  5072:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5073:     if ($realm) {
                   5074:         $realm = '/'.$realm;
                   5075:     }
1.378     raeburn  5076:     if ($role  eq 'ca') {
1.479     albertel 5077:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5078:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5079:     } 
1.55      www      5080: # realm
1.258     albertel 5081:     if ($env{'request.course.id'}) {
1.378     raeburn  5082:         if ($env{'request.role'} !~ /^cr/) {
                   5083:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5084:         }
1.898     raeburn  5085:         if ($env{'request.course.sec'}) {
                   5086:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5087:         }   
1.359     albertel 5088: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5089:     } else {
                   5090:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5091:     }
1.433     albertel 5092: 
1.359     albertel 5093:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5094: 
1.438     albertel 5095:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5096: 
1.101     www      5097: # construct main body tag
1.359     albertel 5098:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5099: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5100: 
1.1075.2.38  raeburn  5101:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5102: 
                   5103:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5104:         return $bodytag;
1.1075.2.38  raeburn  5105:     }
1.359     albertel 5106: 
1.954     raeburn  5107:     if ($public) {
1.433     albertel 5108: 	undef($role);
                   5109:     }
1.359     albertel 5110:     
1.762     bisitz   5111:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5112:     #
                   5113:     # Extra info if you are the DC
                   5114:     my $dc_info = '';
                   5115:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5116:                         $env{'course.'.$env{'request.course.id'}.
                   5117:                                  '.domain'}.'/'})) {
                   5118:         my $cid = $env{'request.course.id'};
1.917     raeburn  5119:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5120:         $dc_info =~ s/\s+$//;
1.359     albertel 5121:     }
                   5122: 
1.898     raeburn  5123:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903     droeschl 5124: 
1.1075.2.13  raeburn  5125:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5126: 
1.1075.2.38  raeburn  5127: 
                   5128: 
1.1075.2.21  raeburn  5129:     my $funclist;
                   5130:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52  raeburn  5131:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21  raeburn  5132:                     Apache::lonmenu::serverform();
                   5133:         my $forbodytag;
                   5134:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5135:                                             $forcereg,$args->{'group'},
                   5136:                                             $args->{'bread_crumbs'},
                   5137:                                             $advtoolsref,'',\$forbodytag);
                   5138:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5139:             $funclist = $forbodytag;
                   5140:         }
                   5141:     } else {
1.903     droeschl 5142: 
                   5143:         #    if ($env{'request.state'} eq 'construct') {
                   5144:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5145:         #    }
                   5146: 
1.1075.2.38  raeburn  5147:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5148:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5149: 
1.1075.2.38  raeburn  5150:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2  raeburn  5151: 
1.916     droeschl 5152:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22  raeburn  5153:             if ($dc_info) {
                   5154:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5155:             }
1.1075.2.38  raeburn  5156:             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22  raeburn  5157:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5158:             return $bodytag;
                   5159:         }
1.894     droeschl 5160: 
1.927     raeburn  5161:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38  raeburn  5162:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5163:         }
1.916     droeschl 5164: 
1.1075.2.38  raeburn  5165:         $bodytag .= $right;
1.852     droeschl 5166: 
1.917     raeburn  5167:         if ($dc_info) {
                   5168:             $dc_info = &dc_courseid_toggle($dc_info);
                   5169:         }
                   5170:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5171: 
1.1075.2.61  raeburn  5172:         #if directed to not display the secondary menu, don't.
                   5173:         if ($args->{'no_secondary_menu'}) {
                   5174:             return $bodytag;
                   5175:         }
1.903     droeschl 5176:         #don't show menus for public users
1.954     raeburn  5177:         if (!$public){
1.1075.2.52  raeburn  5178:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5179:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5180:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5181:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5182:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5183:                                 $args->{'bread_crumbs'});
                   5184:             } elsif ($forcereg) { 
1.1075.2.22  raeburn  5185:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5186:                                                             $args->{'group'});
1.1075.2.15  raeburn  5187:             } else {
1.1075.2.21  raeburn  5188:                 my $forbodytag;
                   5189:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5190:                                                     $forcereg,$args->{'group'},
                   5191:                                                     $args->{'bread_crumbs'},
                   5192:                                                     $advtoolsref,'',\$forbodytag);
                   5193:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5194:                     $bodytag .= $forbodytag;
                   5195:                 }
1.920     raeburn  5196:             }
1.903     droeschl 5197:         }else{
                   5198:             # this is to seperate menu from content when there's no secondary
                   5199:             # menu. Especially needed for public accessible ressources.
                   5200:             $bodytag .= '<hr style="clear:both" />';
                   5201:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5202:         }
1.903     droeschl 5203: 
1.235     raeburn  5204:         return $bodytag;
1.1075.2.12  raeburn  5205:     }
                   5206: 
                   5207: #
                   5208: # Top frame rendering, Remote is up
                   5209: #
                   5210: 
                   5211:     my $imgsrc = $img;
                   5212:     if ($img =~ /^\/adm/) {
                   5213:         $imgsrc = &lonhttpdurl($img);
                   5214:     }
                   5215:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5216: 
1.1075.2.60  raeburn  5217:     my $help=($no_inline_link?''
                   5218:               :&Apache::loncommon::top_nav_help('Help'));
                   5219: 
1.1075.2.12  raeburn  5220:     # Explicit link to get inline menu
                   5221:     my $menu= ($no_inline_link?''
                   5222:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5223: 
                   5224:     if ($dc_info) {
                   5225:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5226:     }
                   5227: 
1.1075.2.38  raeburn  5228:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
                   5229:     unless ($public) {
                   5230:         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5231:                                 undef,'LC_menubuttons_link');
                   5232:     }
                   5233: 
1.1075.2.12  raeburn  5234:     unless ($env{'form.inhibitmenu'}) {
                   5235:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38  raeburn  5236:                        <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60  raeburn  5237:                        <li>$help</li>
1.1075.2.12  raeburn  5238:                        <li>$menu</li>
                   5239:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5240:     }
1.1075.2.13  raeburn  5241:     if ($env{'request.state'} eq 'construct') {
                   5242:         if (!$public){
                   5243:             if ($env{'request.state'} eq 'construct') {
                   5244:                 $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5245:                                 &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13  raeburn  5246:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5247:                             &Apache::lonmenu::innerregister($forcereg,
                   5248:                                                             $args->{'bread_crumbs'});
                   5249:             }
                   5250:         }
                   5251:     }
1.1075.2.21  raeburn  5252:     return $bodytag."\n".$funclist;
1.182     matthew  5253: }
                   5254: 
1.917     raeburn  5255: sub dc_courseid_toggle {
                   5256:     my ($dc_info) = @_;
1.980     raeburn  5257:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5258:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5259:            &mt('(More ...)').'</a></span>'.
                   5260:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5261: }
                   5262: 
1.330     albertel 5263: sub make_attr_string {
                   5264:     my ($register,$attr_ref) = @_;
                   5265: 
                   5266:     if ($attr_ref && !ref($attr_ref)) {
                   5267: 	die("addentries Must be a hash ref ".
                   5268: 	    join(':',caller(1))." ".
                   5269: 	    join(':',caller(0))." ");
                   5270:     }
                   5271: 
                   5272:     if ($register) {
1.339     albertel 5273: 	my ($on_load,$on_unload);
                   5274: 	foreach my $key (keys(%{$attr_ref})) {
                   5275: 	    if      (lc($key) eq 'onload') {
                   5276: 		$on_load.=$attr_ref->{$key}.';';
                   5277: 		delete($attr_ref->{$key});
                   5278: 
                   5279: 	    } elsif (lc($key) eq 'onunload') {
                   5280: 		$on_unload.=$attr_ref->{$key}.';';
                   5281: 		delete($attr_ref->{$key});
                   5282: 	    }
                   5283: 	}
1.1075.2.12  raeburn  5284:         if ($env{'environment.remote'} eq 'on') {
                   5285:             $attr_ref->{'onload'}  =
                   5286:                 &Apache::lonmenu::loadevents().  $on_load;
                   5287:             $attr_ref->{'onunload'}=
                   5288:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5289:         } else {  
                   5290: 	    $attr_ref->{'onload'}  = $on_load;
                   5291: 	    $attr_ref->{'onunload'}= $on_unload;
                   5292:         }
1.330     albertel 5293:     }
1.339     albertel 5294: 
1.330     albertel 5295:     my $attr_string;
1.1075.2.56  raeburn  5296:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5297: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5298:     }
                   5299:     return $attr_string;
                   5300: }
                   5301: 
                   5302: 
1.182     matthew  5303: ###############################################
1.251     albertel 5304: ###############################################
                   5305: 
                   5306: =pod
                   5307: 
                   5308: =item * &endbodytag()
                   5309: 
                   5310: Returns a uniform footer for LON-CAPA web pages.
                   5311: 
1.635     raeburn  5312: Inputs: 1 - optional reference to an args hash
                   5313: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5314: a 'Continue' link is not displayed if the page contains an
                   5315: internal redirect in the <head></head> section,
                   5316: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5317: 
                   5318: =cut
                   5319: 
                   5320: sub endbodytag {
1.635     raeburn  5321:     my ($args) = @_;
1.1075.2.6  raeburn  5322:     my $endbodytag;
                   5323:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5324:         $endbodytag='</body>';
                   5325:     }
1.269     albertel 5326:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5327:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5328:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5329: 	    $endbodytag=
                   5330: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5331: 	        &mt('Continue').'</a>'.
                   5332: 	        $endbodytag;
                   5333:         }
1.315     albertel 5334:     }
1.251     albertel 5335:     return $endbodytag;
                   5336: }
                   5337: 
1.352     albertel 5338: =pod
                   5339: 
                   5340: =item * &standard_css()
                   5341: 
                   5342: Returns a style sheet
                   5343: 
                   5344: Inputs: (all optional)
                   5345:             domain         -> force to color decorate a page for a specific
                   5346:                                domain
                   5347:             function       -> force usage of a specific rolish color scheme
                   5348:             bgcolor        -> override the default page bgcolor
                   5349: 
                   5350: =cut
                   5351: 
1.343     albertel 5352: sub standard_css {
1.345     albertel 5353:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5354:     $function  = &get_users_function() if (!$function);
                   5355:     my $img    = &designparm($function.'.img',   $domain);
                   5356:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5357:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5358:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5359: #second colour for later usage
1.345     albertel 5360:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5361:     my $pgbg_or_bgcolor =
                   5362: 	         $bgcolor ||
1.352     albertel 5363: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5364:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5365:     my $alink  = &designparm($function.'.alink', $domain);
                   5366:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5367:     my $link   = &designparm($function.'.link',  $domain);
                   5368: 
1.602     albertel 5369:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5370:     my $mono                 = 'monospace';
1.850     bisitz   5371:     my $data_table_head      = $sidebg;
                   5372:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5373:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5374:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5375:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5376:     my $mail_new             = '#FFBB77';
                   5377:     my $mail_new_hover       = '#DD9955';
                   5378:     my $mail_read            = '#BBBB77';
                   5379:     my $mail_read_hover      = '#999944';
                   5380:     my $mail_replied         = '#AAAA88';
                   5381:     my $mail_replied_hover   = '#888855';
                   5382:     my $mail_other           = '#99BBBB';
                   5383:     my $mail_other_hover     = '#669999';
1.391     albertel 5384:     my $table_header         = '#DDDDDD';
1.489     raeburn  5385:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5386:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5387:     my $button_hover         = '#BF2317';
1.392     albertel 5388: 
1.608     albertel 5389:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5390:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5391:                                              : '0 3px 0 4px';
1.448     albertel 5392: 
1.523     albertel 5393: 
1.343     albertel 5394:     return <<END;
1.947     droeschl 5395: 
                   5396: /* needed for iframe to allow 100% height in FF */
                   5397: body, html { 
                   5398:     margin: 0;
                   5399:     padding: 0 0.5%;
                   5400:     height: 99%; /* to avoid scrollbars */
                   5401: }
                   5402: 
1.795     www      5403: body {
1.911     bisitz   5404:   font-family: $sans;
                   5405:   line-height:130%;
                   5406:   font-size:0.83em;
                   5407:   color:$font;
1.795     www      5408: }
                   5409: 
1.959     onken    5410: a:focus,
                   5411: a:focus img {
1.795     www      5412:   color: red;
                   5413: }
1.698     harmsja  5414: 
1.911     bisitz   5415: form, .inline {
                   5416:   display: inline;
1.795     www      5417: }
1.721     harmsja  5418: 
1.795     www      5419: .LC_right {
1.911     bisitz   5420:   text-align:right;
1.795     www      5421: }
                   5422: 
                   5423: .LC_middle {
1.911     bisitz   5424:   vertical-align:middle;
1.795     www      5425: }
1.721     harmsja  5426: 
1.1075.2.38  raeburn  5427: .LC_floatleft {
                   5428:   float: left;
                   5429: }
                   5430: 
                   5431: .LC_floatright {
                   5432:   float: right;
                   5433: }
                   5434: 
1.911     bisitz   5435: .LC_400Box {
                   5436:   width:400px;
                   5437: }
1.721     harmsja  5438: 
1.947     droeschl 5439: .LC_iframecontainer {
                   5440:     width: 98%;
                   5441:     margin: 0;
                   5442:     position: fixed;
                   5443:     top: 8.5em;
                   5444:     bottom: 0;
                   5445: }
                   5446: 
                   5447: .LC_iframecontainer iframe{
                   5448:     border: none;
                   5449:     width: 100%;
                   5450:     height: 100%;
                   5451: }
                   5452: 
1.778     bisitz   5453: .LC_filename {
                   5454:   font-family: $mono;
                   5455:   white-space:pre;
1.921     bisitz   5456:   font-size: 120%;
1.778     bisitz   5457: }
                   5458: 
                   5459: .LC_fileicon {
                   5460:   border: none;
                   5461:   height: 1.3em;
                   5462:   vertical-align: text-bottom;
                   5463:   margin-right: 0.3em;
                   5464:   text-decoration:none;
                   5465: }
                   5466: 
1.1008    www      5467: .LC_setting {
                   5468:   text-decoration:underline;
                   5469: }
                   5470: 
1.350     albertel 5471: .LC_error {
                   5472:   color: red;
                   5473: }
1.795     www      5474: 
1.1075.2.15  raeburn  5475: .LC_warning {
                   5476:   color: darkorange;
                   5477: }
                   5478: 
1.457     albertel 5479: .LC_diff_removed {
1.733     bisitz   5480:   color: red;
1.394     albertel 5481: }
1.532     albertel 5482: 
                   5483: .LC_info,
1.457     albertel 5484: .LC_success,
                   5485: .LC_diff_added {
1.350     albertel 5486:   color: green;
                   5487: }
1.795     www      5488: 
1.802     bisitz   5489: div.LC_confirm_box {
                   5490:   background-color: #FAFAFA;
                   5491:   border: 1px solid $lg_border_color;
                   5492:   margin-right: 0;
                   5493:   padding: 5px;
                   5494: }
                   5495: 
                   5496: div.LC_confirm_box .LC_error img,
                   5497: div.LC_confirm_box .LC_success img {
                   5498:   vertical-align: middle;
                   5499: }
                   5500: 
1.440     albertel 5501: .LC_icon {
1.771     droeschl 5502:   border: none;
1.790     droeschl 5503:   vertical-align: middle;
1.771     droeschl 5504: }
                   5505: 
1.543     albertel 5506: .LC_docs_spacer {
                   5507:   width: 25px;
                   5508:   height: 1px;
1.771     droeschl 5509:   border: none;
1.543     albertel 5510: }
1.346     albertel 5511: 
1.532     albertel 5512: .LC_internal_info {
1.735     bisitz   5513:   color: #999999;
1.532     albertel 5514: }
                   5515: 
1.794     www      5516: .LC_discussion {
1.1050    www      5517:   background: $data_table_dark;
1.911     bisitz   5518:   border: 1px solid black;
                   5519:   margin: 2px;
1.794     www      5520: }
                   5521: 
                   5522: .LC_disc_action_left {
1.1050    www      5523:   background: $sidebg;
1.911     bisitz   5524:   text-align: left;
1.1050    www      5525:   padding: 4px;
                   5526:   margin: 2px;
1.794     www      5527: }
                   5528: 
                   5529: .LC_disc_action_right {
1.1050    www      5530:   background: $sidebg;
1.911     bisitz   5531:   text-align: right;
1.1050    www      5532:   padding: 4px;
                   5533:   margin: 2px;
1.794     www      5534: }
                   5535: 
                   5536: .LC_disc_new_item {
1.911     bisitz   5537:   background: white;
                   5538:   border: 2px solid red;
1.1050    www      5539:   margin: 4px;
                   5540:   padding: 4px;
1.794     www      5541: }
                   5542: 
                   5543: .LC_disc_old_item {
1.911     bisitz   5544:   background: white;
1.1050    www      5545:   margin: 4px;
                   5546:   padding: 4px;
1.794     www      5547: }
                   5548: 
1.458     albertel 5549: table.LC_pastsubmission {
                   5550:   border: 1px solid black;
                   5551:   margin: 2px;
                   5552: }
                   5553: 
1.924     bisitz   5554: table#LC_menubuttons {
1.345     albertel 5555:   width: 100%;
                   5556:   background: $pgbg;
1.392     albertel 5557:   border: 2px;
1.402     albertel 5558:   border-collapse: separate;
1.803     bisitz   5559:   padding: 0;
1.345     albertel 5560: }
1.392     albertel 5561: 
1.801     tempelho 5562: table#LC_title_bar a {
                   5563:   color: $fontmenu;
                   5564: }
1.836     bisitz   5565: 
1.807     droeschl 5566: table#LC_title_bar {
1.819     tempelho 5567:   clear: both;
1.836     bisitz   5568:   display: none;
1.807     droeschl 5569: }
                   5570: 
1.795     www      5571: table#LC_title_bar,
1.933     droeschl 5572: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5573: table#LC_title_bar.LC_with_remote {
1.359     albertel 5574:   width: 100%;
1.392     albertel 5575:   border-color: $pgbg;
                   5576:   border-style: solid;
                   5577:   border-width: $border;
1.379     albertel 5578:   background: $pgbg;
1.801     tempelho 5579:   color: $fontmenu;
1.392     albertel 5580:   border-collapse: collapse;
1.803     bisitz   5581:   padding: 0;
1.819     tempelho 5582:   margin: 0;
1.359     albertel 5583: }
1.795     www      5584: 
1.933     droeschl 5585: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5586:     margin: 0;
                   5587:     padding: 0;
1.933     droeschl 5588:     position: relative;
                   5589:     list-style: none;
1.913     droeschl 5590: }
1.933     droeschl 5591: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5592:     display: inline;
                   5593: }
1.933     droeschl 5594: 
                   5595: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5596:     padding: 0;
1.933     droeschl 5597:     margin: 0;
                   5598:     float: left;
1.913     droeschl 5599: }
1.933     droeschl 5600: .LC_breadcrumb_tools_tools {
                   5601:     padding: 0;
                   5602:     margin: 0;
1.913     droeschl 5603:     float: right;
                   5604: }
                   5605: 
1.359     albertel 5606: table#LC_title_bar td {
                   5607:   background: $tabbg;
                   5608: }
1.795     www      5609: 
1.911     bisitz   5610: table#LC_menubuttons img {
1.803     bisitz   5611:   border: none;
1.346     albertel 5612: }
1.795     www      5613: 
1.842     droeschl 5614: .LC_breadcrumbs_component {
1.911     bisitz   5615:   float: right;
                   5616:   margin: 0 1em;
1.357     albertel 5617: }
1.842     droeschl 5618: .LC_breadcrumbs_component img {
1.911     bisitz   5619:   vertical-align: middle;
1.777     tempelho 5620: }
1.795     www      5621: 
1.383     albertel 5622: td.LC_table_cell_checkbox {
                   5623:   text-align: center;
                   5624: }
1.795     www      5625: 
                   5626: .LC_fontsize_small {
1.911     bisitz   5627:   font-size: 70%;
1.705     tempelho 5628: }
                   5629: 
1.844     bisitz   5630: #LC_breadcrumbs {
1.911     bisitz   5631:   clear:both;
                   5632:   background: $sidebg;
                   5633:   border-bottom: 1px solid $lg_border_color;
                   5634:   line-height: 2.5em;
1.933     droeschl 5635:   overflow: hidden;
1.911     bisitz   5636:   margin: 0;
                   5637:   padding: 0;
1.995     raeburn  5638:   text-align: left;
1.819     tempelho 5639: }
1.862     bisitz   5640: 
1.1075.2.16  raeburn  5641: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5642:   clear:both;
                   5643:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5644:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  5645:   margin: 0 0 10px 0;
1.966     bisitz   5646:   padding: 3px;
1.995     raeburn  5647:   text-align: left;
1.822     bisitz   5648: }
                   5649: 
1.795     www      5650: .LC_fontsize_medium {
1.911     bisitz   5651:   font-size: 85%;
1.705     tempelho 5652: }
                   5653: 
1.795     www      5654: .LC_fontsize_large {
1.911     bisitz   5655:   font-size: 120%;
1.705     tempelho 5656: }
                   5657: 
1.346     albertel 5658: .LC_menubuttons_inline_text {
                   5659:   color: $font;
1.698     harmsja  5660:   font-size: 90%;
1.701     harmsja  5661:   padding-left:3px;
1.346     albertel 5662: }
                   5663: 
1.934     droeschl 5664: .LC_menubuttons_inline_text img{
                   5665:   vertical-align: middle;
                   5666: }
                   5667: 
1.1051    www      5668: li.LC_menubuttons_inline_text img {
1.951     onken    5669:   cursor:pointer;
1.1002    droeschl 5670:   text-decoration: none;
1.951     onken    5671: }
                   5672: 
1.526     www      5673: .LC_menubuttons_link {
                   5674:   text-decoration: none;
                   5675: }
1.795     www      5676: 
1.522     albertel 5677: .LC_menubuttons_category {
1.521     www      5678:   color: $font;
1.526     www      5679:   background: $pgbg;
1.521     www      5680:   font-size: larger;
                   5681:   font-weight: bold;
                   5682: }
                   5683: 
1.346     albertel 5684: td.LC_menubuttons_text {
1.911     bisitz   5685:   color: $font;
1.346     albertel 5686: }
1.706     harmsja  5687: 
1.346     albertel 5688: .LC_current_location {
                   5689:   background: $tabbg;
                   5690: }
1.795     www      5691: 
1.938     bisitz   5692: table.LC_data_table {
1.347     albertel 5693:   border: 1px solid #000000;
1.402     albertel 5694:   border-collapse: separate;
1.426     albertel 5695:   border-spacing: 1px;
1.610     albertel 5696:   background: $pgbg;
1.347     albertel 5697: }
1.795     www      5698: 
1.422     albertel 5699: .LC_data_table_dense {
                   5700:   font-size: small;
                   5701: }
1.795     www      5702: 
1.507     raeburn  5703: table.LC_nested_outer {
                   5704:   border: 1px solid #000000;
1.589     raeburn  5705:   border-collapse: collapse;
1.803     bisitz   5706:   border-spacing: 0;
1.507     raeburn  5707:   width: 100%;
                   5708: }
1.795     www      5709: 
1.879     raeburn  5710: table.LC_innerpickbox,
1.507     raeburn  5711: table.LC_nested {
1.803     bisitz   5712:   border: none;
1.589     raeburn  5713:   border-collapse: collapse;
1.803     bisitz   5714:   border-spacing: 0;
1.507     raeburn  5715:   width: 100%;
                   5716: }
1.795     www      5717: 
1.911     bisitz   5718: table.LC_data_table tr th,
                   5719: table.LC_calendar tr th,
1.879     raeburn  5720: table.LC_prior_tries tr th,
                   5721: table.LC_innerpickbox tr th {
1.349     albertel 5722:   font-weight: bold;
                   5723:   background-color: $data_table_head;
1.801     tempelho 5724:   color:$fontmenu;
1.701     harmsja  5725:   font-size:90%;
1.347     albertel 5726: }
1.795     www      5727: 
1.879     raeburn  5728: table.LC_innerpickbox tr th,
                   5729: table.LC_innerpickbox tr td {
                   5730:   vertical-align: top;
                   5731: }
                   5732: 
1.711     raeburn  5733: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5734:   background-color: #CCCCCC;
1.711     raeburn  5735:   font-weight: bold;
                   5736:   text-align: left;
                   5737: }
1.795     www      5738: 
1.912     bisitz   5739: table.LC_data_table tr.LC_odd_row > td {
                   5740:   background-color: $data_table_light;
                   5741:   padding: 2px;
                   5742:   vertical-align: top;
                   5743: }
                   5744: 
1.809     bisitz   5745: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5746:   background-color: $data_table_light;
1.912     bisitz   5747:   vertical-align: top;
                   5748: }
                   5749: 
                   5750: table.LC_data_table tr.LC_even_row > td {
                   5751:   background-color: $data_table_dark;
1.425     albertel 5752:   padding: 2px;
1.900     bisitz   5753:   vertical-align: top;
1.347     albertel 5754: }
1.795     www      5755: 
1.809     bisitz   5756: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5757:   background-color: $data_table_dark;
1.900     bisitz   5758:   vertical-align: top;
1.347     albertel 5759: }
1.795     www      5760: 
1.425     albertel 5761: table.LC_data_table tr.LC_data_table_highlight td {
                   5762:   background-color: $data_table_darker;
                   5763: }
1.795     www      5764: 
1.639     raeburn  5765: table.LC_data_table tr td.LC_leftcol_header {
                   5766:   background-color: $data_table_head;
                   5767:   font-weight: bold;
                   5768: }
1.795     www      5769: 
1.451     albertel 5770: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5771: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5772:   font-weight: bold;
                   5773:   font-style: italic;
                   5774:   text-align: center;
                   5775:   padding: 8px;
1.347     albertel 5776: }
1.795     www      5777: 
1.1075.2.30  raeburn  5778: table.LC_data_table tr.LC_empty_row td,
                   5779: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   5780:   background-color: $sidebg;
                   5781: }
                   5782: 
                   5783: table.LC_nested tr.LC_empty_row td {
                   5784:   background-color: #FFFFFF;
                   5785: }
                   5786: 
1.890     droeschl 5787: table.LC_caption {
                   5788: }
                   5789: 
1.507     raeburn  5790: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5791:   padding: 4ex
                   5792: }
1.795     www      5793: 
1.507     raeburn  5794: table.LC_nested_outer tr th {
                   5795:   font-weight: bold;
1.801     tempelho 5796:   color:$fontmenu;
1.507     raeburn  5797:   background-color: $data_table_head;
1.701     harmsja  5798:   font-size: small;
1.507     raeburn  5799:   border-bottom: 1px solid #000000;
                   5800: }
1.795     www      5801: 
1.507     raeburn  5802: table.LC_nested_outer tr td.LC_subheader {
                   5803:   background-color: $data_table_head;
                   5804:   font-weight: bold;
                   5805:   font-size: small;
                   5806:   border-bottom: 1px solid #000000;
                   5807:   text-align: right;
1.451     albertel 5808: }
1.795     www      5809: 
1.507     raeburn  5810: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5811:   background-color: #CCCCCC;
1.451     albertel 5812:   font-weight: bold;
                   5813:   font-size: small;
1.507     raeburn  5814:   text-align: center;
                   5815: }
1.795     www      5816: 
1.589     raeburn  5817: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5818: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5819:   text-align: left;
1.451     albertel 5820: }
1.795     www      5821: 
1.507     raeburn  5822: table.LC_nested td {
1.735     bisitz   5823:   background-color: #FFFFFF;
1.451     albertel 5824:   font-size: small;
1.507     raeburn  5825: }
1.795     www      5826: 
1.507     raeburn  5827: table.LC_nested_outer tr th.LC_right_item,
                   5828: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5829: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5830: table.LC_nested tr td.LC_right_item {
1.451     albertel 5831:   text-align: right;
                   5832: }
                   5833: 
1.507     raeburn  5834: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5835:   background-color: #EEEEEE;
1.451     albertel 5836: }
                   5837: 
1.473     raeburn  5838: table.LC_createuser {
                   5839: }
                   5840: 
                   5841: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5842:   font-size: small;
1.473     raeburn  5843: }
                   5844: 
                   5845: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5846:   background-color: #CCCCCC;
1.473     raeburn  5847:   font-weight: bold;
                   5848:   text-align: center;
                   5849: }
                   5850: 
1.349     albertel 5851: table.LC_calendar {
                   5852:   border: 1px solid #000000;
                   5853:   border-collapse: collapse;
1.917     raeburn  5854:   width: 98%;
1.349     albertel 5855: }
1.795     www      5856: 
1.349     albertel 5857: table.LC_calendar_pickdate {
                   5858:   font-size: xx-small;
                   5859: }
1.795     www      5860: 
1.349     albertel 5861: table.LC_calendar tr td {
                   5862:   border: 1px solid #000000;
                   5863:   vertical-align: top;
1.917     raeburn  5864:   width: 14%;
1.349     albertel 5865: }
1.795     www      5866: 
1.349     albertel 5867: table.LC_calendar tr td.LC_calendar_day_empty {
                   5868:   background-color: $data_table_dark;
                   5869: }
1.795     www      5870: 
1.779     bisitz   5871: table.LC_calendar tr td.LC_calendar_day_current {
                   5872:   background-color: $data_table_highlight;
1.777     tempelho 5873: }
1.795     www      5874: 
1.938     bisitz   5875: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5876:   background-color: $mail_new;
                   5877: }
1.795     www      5878: 
1.938     bisitz   5879: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5880:   background-color: $mail_new_hover;
                   5881: }
1.795     www      5882: 
1.938     bisitz   5883: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5884:   background-color: $mail_read;
                   5885: }
1.795     www      5886: 
1.938     bisitz   5887: /*
                   5888: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5889:   background-color: $mail_read_hover;
                   5890: }
1.938     bisitz   5891: */
1.795     www      5892: 
1.938     bisitz   5893: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5894:   background-color: $mail_replied;
                   5895: }
1.795     www      5896: 
1.938     bisitz   5897: /*
                   5898: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5899:   background-color: $mail_replied_hover;
                   5900: }
1.938     bisitz   5901: */
1.795     www      5902: 
1.938     bisitz   5903: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5904:   background-color: $mail_other;
                   5905: }
1.795     www      5906: 
1.938     bisitz   5907: /*
                   5908: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5909:   background-color: $mail_other_hover;
                   5910: }
1.938     bisitz   5911: */
1.494     raeburn  5912: 
1.777     tempelho 5913: table.LC_data_table tr > td.LC_browser_file,
                   5914: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5915:   background: #AAEE77;
1.389     albertel 5916: }
1.795     www      5917: 
1.777     tempelho 5918: table.LC_data_table tr > td.LC_browser_file_locked,
                   5919: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5920:   background: #FFAA99;
1.387     albertel 5921: }
1.795     www      5922: 
1.777     tempelho 5923: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5924:   background: #888888;
1.779     bisitz   5925: }
1.795     www      5926: 
1.777     tempelho 5927: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5928: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5929:   background: #F8F866;
1.777     tempelho 5930: }
1.795     www      5931: 
1.696     bisitz   5932: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5933:   background: #E0E8FF;
1.387     albertel 5934: }
1.696     bisitz   5935: 
1.707     bisitz   5936: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5937:   /* background: #77FF77; */
1.707     bisitz   5938: }
1.795     www      5939: 
1.707     bisitz   5940: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5941:   border-right: 8px solid #FFFF77;
1.707     bisitz   5942: }
1.795     www      5943: 
1.707     bisitz   5944: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5945:   border-right: 8px solid #FFAA77;
1.707     bisitz   5946: }
1.795     www      5947: 
1.707     bisitz   5948: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5949:   border-right: 8px solid #FF7777;
1.707     bisitz   5950: }
1.795     www      5951: 
1.707     bisitz   5952: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5953:   border-right: 8px solid #AAFF77;
1.707     bisitz   5954: }
1.795     www      5955: 
1.707     bisitz   5956: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5957:   border-right: 8px solid #11CC55;
1.707     bisitz   5958: }
                   5959: 
1.388     albertel 5960: span.LC_current_location {
1.701     harmsja  5961:   font-size:larger;
1.388     albertel 5962:   background: $pgbg;
                   5963: }
1.387     albertel 5964: 
1.1029    www      5965: span.LC_current_nav_location {
                   5966:   font-weight:bold;
                   5967:   background: $sidebg;
                   5968: }
                   5969: 
1.395     albertel 5970: span.LC_parm_menu_item {
                   5971:   font-size: larger;
                   5972: }
1.795     www      5973: 
1.395     albertel 5974: span.LC_parm_scope_all {
                   5975:   color: red;
                   5976: }
1.795     www      5977: 
1.395     albertel 5978: span.LC_parm_scope_folder {
                   5979:   color: green;
                   5980: }
1.795     www      5981: 
1.395     albertel 5982: span.LC_parm_scope_resource {
                   5983:   color: orange;
                   5984: }
1.795     www      5985: 
1.395     albertel 5986: span.LC_parm_part {
                   5987:   color: blue;
                   5988: }
1.795     www      5989: 
1.911     bisitz   5990: span.LC_parm_folder,
                   5991: span.LC_parm_symb {
1.395     albertel 5992:   font-size: x-small;
                   5993:   font-family: $mono;
                   5994:   color: #AAAAAA;
                   5995: }
                   5996: 
1.977     bisitz   5997: ul.LC_parm_parmlist li {
                   5998:   display: inline-block;
                   5999:   padding: 0.3em 0.8em;
                   6000:   vertical-align: top;
                   6001:   width: 150px;
                   6002:   border-top:1px solid $lg_border_color;
                   6003: }
                   6004: 
1.795     www      6005: td.LC_parm_overview_level_menu,
                   6006: td.LC_parm_overview_map_menu,
                   6007: td.LC_parm_overview_parm_selectors,
                   6008: td.LC_parm_overview_restrictions  {
1.396     albertel 6009:   border: 1px solid black;
                   6010:   border-collapse: collapse;
                   6011: }
1.795     www      6012: 
1.396     albertel 6013: table.LC_parm_overview_restrictions td {
                   6014:   border-width: 1px 4px 1px 4px;
                   6015:   border-style: solid;
                   6016:   border-color: $pgbg;
                   6017:   text-align: center;
                   6018: }
1.795     www      6019: 
1.396     albertel 6020: table.LC_parm_overview_restrictions th {
                   6021:   background: $tabbg;
                   6022:   border-width: 1px 4px 1px 4px;
                   6023:   border-style: solid;
                   6024:   border-color: $pgbg;
                   6025: }
1.795     www      6026: 
1.398     albertel 6027: table#LC_helpmenu {
1.803     bisitz   6028:   border: none;
1.398     albertel 6029:   height: 55px;
1.803     bisitz   6030:   border-spacing: 0;
1.398     albertel 6031: }
                   6032: 
                   6033: table#LC_helpmenu fieldset legend {
                   6034:   font-size: larger;
                   6035: }
1.795     www      6036: 
1.397     albertel 6037: table#LC_helpmenu_links {
                   6038:   width: 100%;
                   6039:   border: 1px solid black;
                   6040:   background: $pgbg;
1.803     bisitz   6041:   padding: 0;
1.397     albertel 6042:   border-spacing: 1px;
                   6043: }
1.795     www      6044: 
1.397     albertel 6045: table#LC_helpmenu_links tr td {
                   6046:   padding: 1px;
                   6047:   background: $tabbg;
1.399     albertel 6048:   text-align: center;
                   6049:   font-weight: bold;
1.397     albertel 6050: }
1.396     albertel 6051: 
1.795     www      6052: table#LC_helpmenu_links a:link,
                   6053: table#LC_helpmenu_links a:visited,
1.397     albertel 6054: table#LC_helpmenu_links a:active {
                   6055:   text-decoration: none;
                   6056:   color: $font;
                   6057: }
1.795     www      6058: 
1.397     albertel 6059: table#LC_helpmenu_links a:hover {
                   6060:   text-decoration: underline;
                   6061:   color: $vlink;
                   6062: }
1.396     albertel 6063: 
1.417     albertel 6064: .LC_chrt_popup_exists {
                   6065:   border: 1px solid #339933;
                   6066:   margin: -1px;
                   6067: }
1.795     www      6068: 
1.417     albertel 6069: .LC_chrt_popup_up {
                   6070:   border: 1px solid yellow;
                   6071:   margin: -1px;
                   6072: }
1.795     www      6073: 
1.417     albertel 6074: .LC_chrt_popup {
                   6075:   border: 1px solid #8888FF;
                   6076:   background: #CCCCFF;
                   6077: }
1.795     www      6078: 
1.421     albertel 6079: table.LC_pick_box {
                   6080:   border-collapse: separate;
                   6081:   background: white;
                   6082:   border: 1px solid black;
                   6083:   border-spacing: 1px;
                   6084: }
1.795     www      6085: 
1.421     albertel 6086: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6087:   background: $sidebg;
1.421     albertel 6088:   font-weight: bold;
1.900     bisitz   6089:   text-align: left;
1.740     bisitz   6090:   vertical-align: top;
1.421     albertel 6091:   width: 184px;
                   6092:   padding: 8px;
                   6093: }
1.795     www      6094: 
1.579     raeburn  6095: table.LC_pick_box td.LC_pick_box_value {
                   6096:   text-align: left;
                   6097:   padding: 8px;
                   6098: }
1.795     www      6099: 
1.579     raeburn  6100: table.LC_pick_box td.LC_pick_box_select {
                   6101:   text-align: left;
                   6102:   padding: 8px;
                   6103: }
1.795     www      6104: 
1.424     albertel 6105: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6106:   padding: 0;
1.421     albertel 6107:   height: 1px;
                   6108:   background: black;
                   6109: }
1.795     www      6110: 
1.421     albertel 6111: table.LC_pick_box td.LC_pick_box_submit {
                   6112:   text-align: right;
                   6113: }
1.795     www      6114: 
1.579     raeburn  6115: table.LC_pick_box td.LC_evenrow_value {
                   6116:   text-align: left;
                   6117:   padding: 8px;
                   6118:   background-color: $data_table_light;
                   6119: }
1.795     www      6120: 
1.579     raeburn  6121: table.LC_pick_box td.LC_oddrow_value {
                   6122:   text-align: left;
                   6123:   padding: 8px;
                   6124:   background-color: $data_table_light;
                   6125: }
1.795     www      6126: 
1.579     raeburn  6127: span.LC_helpform_receipt_cat {
                   6128:   font-weight: bold;
                   6129: }
1.795     www      6130: 
1.424     albertel 6131: table.LC_group_priv_box {
                   6132:   background: white;
                   6133:   border: 1px solid black;
                   6134:   border-spacing: 1px;
                   6135: }
1.795     www      6136: 
1.424     albertel 6137: table.LC_group_priv_box td.LC_pick_box_title {
                   6138:   background: $tabbg;
                   6139:   font-weight: bold;
                   6140:   text-align: right;
                   6141:   width: 184px;
                   6142: }
1.795     www      6143: 
1.424     albertel 6144: table.LC_group_priv_box td.LC_groups_fixed {
                   6145:   background: $data_table_light;
                   6146:   text-align: center;
                   6147: }
1.795     www      6148: 
1.424     albertel 6149: table.LC_group_priv_box td.LC_groups_optional {
                   6150:   background: $data_table_dark;
                   6151:   text-align: center;
                   6152: }
1.795     www      6153: 
1.424     albertel 6154: table.LC_group_priv_box td.LC_groups_functionality {
                   6155:   background: $data_table_darker;
                   6156:   text-align: center;
                   6157:   font-weight: bold;
                   6158: }
1.795     www      6159: 
1.424     albertel 6160: table.LC_group_priv td {
                   6161:   text-align: left;
1.803     bisitz   6162:   padding: 0;
1.424     albertel 6163: }
                   6164: 
                   6165: .LC_navbuttons {
                   6166:   margin: 2ex 0ex 2ex 0ex;
                   6167: }
1.795     www      6168: 
1.423     albertel 6169: .LC_topic_bar {
                   6170:   font-weight: bold;
                   6171:   background: $tabbg;
1.918     wenzelju 6172:   margin: 1em 0em 1em 2em;
1.805     bisitz   6173:   padding: 3px;
1.918     wenzelju 6174:   font-size: 1.2em;
1.423     albertel 6175: }
1.795     www      6176: 
1.423     albertel 6177: .LC_topic_bar span {
1.918     wenzelju 6178:   left: 0.5em;
                   6179:   position: absolute;
1.423     albertel 6180:   vertical-align: middle;
1.918     wenzelju 6181:   font-size: 1.2em;
1.423     albertel 6182: }
1.795     www      6183: 
1.423     albertel 6184: table.LC_course_group_status {
                   6185:   margin: 20px;
                   6186: }
1.795     www      6187: 
1.423     albertel 6188: table.LC_status_selector td {
                   6189:   vertical-align: top;
                   6190:   text-align: center;
1.424     albertel 6191:   padding: 4px;
                   6192: }
1.795     www      6193: 
1.599     albertel 6194: div.LC_feedback_link {
1.616     albertel 6195:   clear: both;
1.829     kalberla 6196:   background: $sidebg;
1.779     bisitz   6197:   width: 100%;
1.829     kalberla 6198:   padding-bottom: 10px;
                   6199:   border: 1px $tabbg solid;
1.833     kalberla 6200:   height: 22px;
                   6201:   line-height: 22px;
                   6202:   padding-top: 5px;
                   6203: }
                   6204: 
                   6205: div.LC_feedback_link img {
                   6206:   height: 22px;
1.867     kalberla 6207:   vertical-align:middle;
1.829     kalberla 6208: }
                   6209: 
1.911     bisitz   6210: div.LC_feedback_link a {
1.829     kalberla 6211:   text-decoration: none;
1.489     raeburn  6212: }
1.795     www      6213: 
1.867     kalberla 6214: div.LC_comblock {
1.911     bisitz   6215:   display:inline;
1.867     kalberla 6216:   color:$font;
                   6217:   font-size:90%;
                   6218: }
                   6219: 
                   6220: div.LC_feedback_link div.LC_comblock {
                   6221:   padding-left:5px;
                   6222: }
                   6223: 
                   6224: div.LC_feedback_link div.LC_comblock a {
                   6225:   color:$font;
                   6226: }
                   6227: 
1.489     raeburn  6228: span.LC_feedback_link {
1.858     bisitz   6229:   /* background: $feedback_link_bg; */
1.599     albertel 6230:   font-size: larger;
                   6231: }
1.795     www      6232: 
1.599     albertel 6233: span.LC_message_link {
1.858     bisitz   6234:   /* background: $feedback_link_bg; */
1.599     albertel 6235:   font-size: larger;
                   6236:   position: absolute;
                   6237:   right: 1em;
1.489     raeburn  6238: }
1.421     albertel 6239: 
1.515     albertel 6240: table.LC_prior_tries {
1.524     albertel 6241:   border: 1px solid #000000;
                   6242:   border-collapse: separate;
                   6243:   border-spacing: 1px;
1.515     albertel 6244: }
1.523     albertel 6245: 
1.515     albertel 6246: table.LC_prior_tries td {
1.524     albertel 6247:   padding: 2px;
1.515     albertel 6248: }
1.523     albertel 6249: 
                   6250: .LC_answer_correct {
1.795     www      6251:   background: lightgreen;
                   6252:   color: darkgreen;
                   6253:   padding: 6px;
1.523     albertel 6254: }
1.795     www      6255: 
1.523     albertel 6256: .LC_answer_charged_try {
1.797     www      6257:   background: #FFAAAA;
1.795     www      6258:   color: darkred;
                   6259:   padding: 6px;
1.523     albertel 6260: }
1.795     www      6261: 
1.779     bisitz   6262: .LC_answer_not_charged_try,
1.523     albertel 6263: .LC_answer_no_grade,
                   6264: .LC_answer_late {
1.795     www      6265:   background: lightyellow;
1.523     albertel 6266:   color: black;
1.795     www      6267:   padding: 6px;
1.523     albertel 6268: }
1.795     www      6269: 
1.523     albertel 6270: .LC_answer_previous {
1.795     www      6271:   background: lightblue;
                   6272:   color: darkblue;
                   6273:   padding: 6px;
1.523     albertel 6274: }
1.795     www      6275: 
1.779     bisitz   6276: .LC_answer_no_message {
1.777     tempelho 6277:   background: #FFFFFF;
                   6278:   color: black;
1.795     www      6279:   padding: 6px;
1.779     bisitz   6280: }
1.795     www      6281: 
1.779     bisitz   6282: .LC_answer_unknown {
                   6283:   background: orange;
                   6284:   color: black;
1.795     www      6285:   padding: 6px;
1.777     tempelho 6286: }
1.795     www      6287: 
1.529     albertel 6288: span.LC_prior_numerical,
                   6289: span.LC_prior_string,
                   6290: span.LC_prior_custom,
                   6291: span.LC_prior_reaction,
                   6292: span.LC_prior_math {
1.925     bisitz   6293:   font-family: $mono;
1.523     albertel 6294:   white-space: pre;
                   6295: }
                   6296: 
1.525     albertel 6297: span.LC_prior_string {
1.925     bisitz   6298:   font-family: $mono;
1.525     albertel 6299:   white-space: pre;
                   6300: }
                   6301: 
1.523     albertel 6302: table.LC_prior_option {
                   6303:   width: 100%;
                   6304:   border-collapse: collapse;
                   6305: }
1.795     www      6306: 
1.911     bisitz   6307: table.LC_prior_rank,
1.795     www      6308: table.LC_prior_match {
1.528     albertel 6309:   border-collapse: collapse;
                   6310: }
1.795     www      6311: 
1.528     albertel 6312: table.LC_prior_option tr td,
                   6313: table.LC_prior_rank tr td,
                   6314: table.LC_prior_match tr td {
1.524     albertel 6315:   border: 1px solid #000000;
1.515     albertel 6316: }
                   6317: 
1.855     bisitz   6318: .LC_nobreak {
1.544     albertel 6319:   white-space: nowrap;
1.519     raeburn  6320: }
                   6321: 
1.576     raeburn  6322: span.LC_cusr_emph {
                   6323:   font-style: italic;
                   6324: }
                   6325: 
1.633     raeburn  6326: span.LC_cusr_subheading {
                   6327:   font-weight: normal;
                   6328:   font-size: 85%;
                   6329: }
                   6330: 
1.861     bisitz   6331: div.LC_docs_entry_move {
1.859     bisitz   6332:   border: 1px solid #BBBBBB;
1.545     albertel 6333:   background: #DDDDDD;
1.861     bisitz   6334:   width: 22px;
1.859     bisitz   6335:   padding: 1px;
                   6336:   margin: 0;
1.545     albertel 6337: }
                   6338: 
1.861     bisitz   6339: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6340: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6341:   font-size: x-small;
                   6342: }
1.795     www      6343: 
1.861     bisitz   6344: .LC_docs_entry_parameter {
                   6345:   white-space: nowrap;
                   6346: }
                   6347: 
1.544     albertel 6348: .LC_docs_copy {
1.545     albertel 6349:   color: #000099;
1.544     albertel 6350: }
1.795     www      6351: 
1.544     albertel 6352: .LC_docs_cut {
1.545     albertel 6353:   color: #550044;
1.544     albertel 6354: }
1.795     www      6355: 
1.544     albertel 6356: .LC_docs_rename {
1.545     albertel 6357:   color: #009900;
1.544     albertel 6358: }
1.795     www      6359: 
1.544     albertel 6360: .LC_docs_remove {
1.545     albertel 6361:   color: #990000;
                   6362: }
                   6363: 
1.547     albertel 6364: .LC_docs_reinit_warn,
                   6365: .LC_docs_ext_edit {
                   6366:   font-size: x-small;
                   6367: }
                   6368: 
1.545     albertel 6369: table.LC_docs_adddocs td,
                   6370: table.LC_docs_adddocs th {
                   6371:   border: 1px solid #BBBBBB;
                   6372:   padding: 4px;
                   6373:   background: #DDDDDD;
1.543     albertel 6374: }
                   6375: 
1.584     albertel 6376: table.LC_sty_begin {
                   6377:   background: #BBFFBB;
                   6378: }
1.795     www      6379: 
1.584     albertel 6380: table.LC_sty_end {
                   6381:   background: #FFBBBB;
                   6382: }
                   6383: 
1.589     raeburn  6384: table.LC_double_column {
1.803     bisitz   6385:   border-width: 0;
1.589     raeburn  6386:   border-collapse: collapse;
                   6387:   width: 100%;
                   6388:   padding: 2px;
                   6389: }
                   6390: 
                   6391: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6392:   top: 2px;
1.589     raeburn  6393:   left: 2px;
                   6394:   width: 47%;
                   6395:   vertical-align: top;
                   6396: }
                   6397: 
                   6398: table.LC_double_column tr td.LC_right_col {
                   6399:   top: 2px;
1.779     bisitz   6400:   right: 2px;
1.589     raeburn  6401:   width: 47%;
                   6402:   vertical-align: top;
                   6403: }
                   6404: 
1.591     raeburn  6405: div.LC_left_float {
                   6406:   float: left;
                   6407:   padding-right: 5%;
1.597     albertel 6408:   padding-bottom: 4px;
1.591     raeburn  6409: }
                   6410: 
                   6411: div.LC_clear_float_header {
1.597     albertel 6412:   padding-bottom: 2px;
1.591     raeburn  6413: }
                   6414: 
                   6415: div.LC_clear_float_footer {
1.597     albertel 6416:   padding-top: 10px;
1.591     raeburn  6417:   clear: both;
                   6418: }
                   6419: 
1.597     albertel 6420: div.LC_grade_show_user {
1.941     bisitz   6421: /*  border-left: 5px solid $sidebg; */
                   6422:   border-top: 5px solid #000000;
                   6423:   margin: 50px 0 0 0;
1.936     bisitz   6424:   padding: 15px 0 5px 10px;
1.597     albertel 6425: }
1.795     www      6426: 
1.936     bisitz   6427: div.LC_grade_show_user_odd_row {
1.941     bisitz   6428: /*  border-left: 5px solid #000000; */
                   6429: }
                   6430: 
                   6431: div.LC_grade_show_user div.LC_Box {
                   6432:   margin-right: 50px;
1.597     albertel 6433: }
                   6434: 
                   6435: div.LC_grade_submissions,
                   6436: div.LC_grade_message_center,
1.936     bisitz   6437: div.LC_grade_info_links {
1.597     albertel 6438:   margin: 5px;
                   6439:   width: 99%;
                   6440:   background: #FFFFFF;
                   6441: }
1.795     www      6442: 
1.597     albertel 6443: div.LC_grade_submissions_header,
1.936     bisitz   6444: div.LC_grade_message_center_header {
1.705     tempelho 6445:   font-weight: bold;
                   6446:   font-size: large;
1.597     albertel 6447: }
1.795     www      6448: 
1.597     albertel 6449: div.LC_grade_submissions_body,
1.936     bisitz   6450: div.LC_grade_message_center_body {
1.597     albertel 6451:   border: 1px solid black;
                   6452:   width: 99%;
                   6453:   background: #FFFFFF;
                   6454: }
1.795     www      6455: 
1.613     albertel 6456: table.LC_scantron_action {
                   6457:   width: 100%;
                   6458: }
1.795     www      6459: 
1.613     albertel 6460: table.LC_scantron_action tr th {
1.698     harmsja  6461:   font-weight:bold;
                   6462:   font-style:normal;
1.613     albertel 6463: }
1.795     www      6464: 
1.779     bisitz   6465: .LC_edit_problem_header,
1.614     albertel 6466: div.LC_edit_problem_footer {
1.705     tempelho 6467:   font-weight: normal;
                   6468:   font-size:  medium;
1.602     albertel 6469:   margin: 2px;
1.1060    bisitz   6470:   background-color: $sidebg;
1.600     albertel 6471: }
1.795     www      6472: 
1.600     albertel 6473: div.LC_edit_problem_header,
1.602     albertel 6474: div.LC_edit_problem_header div,
1.614     albertel 6475: div.LC_edit_problem_footer,
                   6476: div.LC_edit_problem_footer div,
1.602     albertel 6477: div.LC_edit_problem_editxml_header,
                   6478: div.LC_edit_problem_editxml_header div {
1.600     albertel 6479:   margin-top: 5px;
                   6480: }
1.795     www      6481: 
1.600     albertel 6482: div.LC_edit_problem_header_title {
1.705     tempelho 6483:   font-weight: bold;
                   6484:   font-size: larger;
1.602     albertel 6485:   background: $tabbg;
                   6486:   padding: 3px;
1.1060    bisitz   6487:   margin: 0 0 5px 0;
1.602     albertel 6488: }
1.795     www      6489: 
1.602     albertel 6490: table.LC_edit_problem_header_title {
                   6491:   width: 100%;
1.600     albertel 6492:   background: $tabbg;
1.602     albertel 6493: }
                   6494: 
                   6495: div.LC_edit_problem_discards {
                   6496:   float: left;
                   6497:   padding-bottom: 5px;
                   6498: }
1.795     www      6499: 
1.602     albertel 6500: div.LC_edit_problem_saves {
                   6501:   float: right;
                   6502:   padding-bottom: 5px;
1.600     albertel 6503: }
1.795     www      6504: 
1.1075.2.34  raeburn  6505: .LC_edit_opt {
                   6506:   padding-left: 1em;
                   6507:   white-space: nowrap;
                   6508: }
                   6509: 
1.1075.2.57  raeburn  6510: .LC_edit_problem_latexhelper{
                   6511:     text-align: right;
                   6512: }
                   6513: 
                   6514: #LC_edit_problem_colorful div{
                   6515:     margin-left: 40px;
                   6516: }
                   6517: 
1.911     bisitz   6518: img.stift {
1.803     bisitz   6519:   border-width: 0;
                   6520:   vertical-align: middle;
1.677     riegler  6521: }
1.680     riegler  6522: 
1.923     bisitz   6523: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6524:   vertical-align: top;
1.777     tempelho 6525: }
1.795     www      6526: 
1.716     raeburn  6527: div.LC_createcourse {
1.911     bisitz   6528:   margin: 10px 10px 10px 10px;
1.716     raeburn  6529: }
                   6530: 
1.917     raeburn  6531: .LC_dccid {
1.1075.2.38  raeburn  6532:   float: right;
1.917     raeburn  6533:   margin: 0.2em 0 0 0;
                   6534:   padding: 0;
                   6535:   font-size: 90%;
                   6536:   display:none;
                   6537: }
                   6538: 
1.897     wenzelju 6539: ol.LC_primary_menu a:hover,
1.721     harmsja  6540: ol#LC_MenuBreadcrumbs a:hover,
                   6541: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6542: ul#LC_secondary_menu a:hover,
1.721     harmsja  6543: .LC_FormSectionClearButton input:hover
1.795     www      6544: ul.LC_TabContent   li:hover a {
1.952     onken    6545:   color:$button_hover;
1.911     bisitz   6546:   text-decoration:none;
1.693     droeschl 6547: }
                   6548: 
1.779     bisitz   6549: h1 {
1.911     bisitz   6550:   padding: 0;
                   6551:   line-height:130%;
1.693     droeschl 6552: }
1.698     harmsja  6553: 
1.911     bisitz   6554: h2,
                   6555: h3,
                   6556: h4,
                   6557: h5,
                   6558: h6 {
                   6559:   margin: 5px 0 5px 0;
                   6560:   padding: 0;
                   6561:   line-height:130%;
1.693     droeschl 6562: }
1.795     www      6563: 
                   6564: .LC_hcell {
1.911     bisitz   6565:   padding:3px 15px 3px 15px;
                   6566:   margin: 0;
                   6567:   background-color:$tabbg;
                   6568:   color:$fontmenu;
                   6569:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6570: }
1.795     www      6571: 
1.840     bisitz   6572: .LC_Box > .LC_hcell {
1.911     bisitz   6573:   margin: 0 -10px 10px -10px;
1.835     bisitz   6574: }
                   6575: 
1.721     harmsja  6576: .LC_noBorder {
1.911     bisitz   6577:   border: 0;
1.698     harmsja  6578: }
1.693     droeschl 6579: 
1.721     harmsja  6580: .LC_FormSectionClearButton input {
1.911     bisitz   6581:   background-color:transparent;
                   6582:   border: none;
                   6583:   cursor:pointer;
                   6584:   text-decoration:underline;
1.693     droeschl 6585: }
1.763     bisitz   6586: 
                   6587: .LC_help_open_topic {
1.911     bisitz   6588:   color: #FFFFFF;
                   6589:   background-color: #EEEEFF;
                   6590:   margin: 1px;
                   6591:   padding: 4px;
                   6592:   border: 1px solid #000033;
                   6593:   white-space: nowrap;
                   6594:   /* vertical-align: middle; */
1.759     neumanie 6595: }
1.693     droeschl 6596: 
1.911     bisitz   6597: dl,
                   6598: ul,
                   6599: div,
                   6600: fieldset {
                   6601:   margin: 10px 10px 10px 0;
                   6602:   /* overflow: hidden; */
1.693     droeschl 6603: }
1.795     www      6604: 
1.838     bisitz   6605: fieldset > legend {
1.911     bisitz   6606:   font-weight: bold;
                   6607:   padding: 0 5px 0 5px;
1.838     bisitz   6608: }
                   6609: 
1.813     bisitz   6610: #LC_nav_bar {
1.911     bisitz   6611:   float: left;
1.995     raeburn  6612:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6613:   margin: 0 0 2px 0;
1.807     droeschl 6614: }
                   6615: 
1.916     droeschl 6616: #LC_realm {
                   6617:   margin: 0.2em 0 0 0;
                   6618:   padding: 0;
                   6619:   font-weight: bold;
                   6620:   text-align: center;
1.995     raeburn  6621:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6622: }
                   6623: 
1.911     bisitz   6624: #LC_nav_bar em {
                   6625:   font-weight: bold;
                   6626:   font-style: normal;
1.807     droeschl 6627: }
                   6628: 
1.897     wenzelju 6629: ol.LC_primary_menu {
1.934     droeschl 6630:   margin: 0;
1.1075.2.2  raeburn  6631:   padding: 0;
1.995     raeburn  6632:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6633: }
                   6634: 
1.852     droeschl 6635: ol#LC_PathBreadcrumbs {
1.911     bisitz   6636:   margin: 0;
1.693     droeschl 6637: }
                   6638: 
1.897     wenzelju 6639: ol.LC_primary_menu li {
1.1075.2.2  raeburn  6640:   color: RGB(80, 80, 80);
                   6641:   vertical-align: middle;
                   6642:   text-align: left;
                   6643:   list-style: none;
                   6644:   float: left;
                   6645: }
                   6646: 
                   6647: ol.LC_primary_menu li a {
                   6648:   display: block;
                   6649:   margin: 0;
                   6650:   padding: 0 5px 0 10px;
                   6651:   text-decoration: none;
                   6652: }
                   6653: 
                   6654: ol.LC_primary_menu li ul {
                   6655:   display: none;
                   6656:   width: 10em;
                   6657:   background-color: $data_table_light;
                   6658: }
                   6659: 
                   6660: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6661:   display: block;
                   6662:   position: absolute;
                   6663:   margin: 0;
                   6664:   padding: 0;
1.1075.2.5  raeburn  6665:   z-index: 2;
1.1075.2.2  raeburn  6666: }
                   6667: 
                   6668: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6669:   font-size: 90%;
1.911     bisitz   6670:   vertical-align: top;
1.1075.2.2  raeburn  6671:   float: none;
1.1075.2.5  raeburn  6672:   border-left: 1px solid black;
                   6673:   border-right: 1px solid black;
1.1075.2.2  raeburn  6674: }
                   6675: 
                   6676: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5  raeburn  6677:   background-color:$data_table_light;
1.1075.2.2  raeburn  6678: }
                   6679: 
                   6680: ol.LC_primary_menu li li a:hover {
                   6681:    color:$button_hover;
                   6682:    background-color:$data_table_dark;
1.693     droeschl 6683: }
                   6684: 
1.897     wenzelju 6685: ol.LC_primary_menu li img {
1.911     bisitz   6686:   vertical-align: bottom;
1.934     droeschl 6687:   height: 1.1em;
1.1075.2.3  raeburn  6688:   margin: 0.2em 0 0 0;
1.693     droeschl 6689: }
                   6690: 
1.897     wenzelju 6691: ol.LC_primary_menu a {
1.911     bisitz   6692:   color: RGB(80, 80, 80);
                   6693:   text-decoration: none;
1.693     droeschl 6694: }
1.795     www      6695: 
1.949     droeschl 6696: ol.LC_primary_menu a.LC_new_message {
                   6697:   font-weight:bold;
                   6698:   color: darkred;
                   6699: }
                   6700: 
1.975     raeburn  6701: ol.LC_docs_parameters {
                   6702:   margin-left: 0;
                   6703:   padding: 0;
                   6704:   list-style: none;
                   6705: }
                   6706: 
                   6707: ol.LC_docs_parameters li {
                   6708:   margin: 0;
                   6709:   padding-right: 20px;
                   6710:   display: inline;
                   6711: }
                   6712: 
1.976     raeburn  6713: ol.LC_docs_parameters li:before {
                   6714:   content: "\\002022 \\0020";
                   6715: }
                   6716: 
                   6717: li.LC_docs_parameters_title {
                   6718:   font-weight: bold;
                   6719: }
                   6720: 
                   6721: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6722:   content: "";
                   6723: }
                   6724: 
1.897     wenzelju 6725: ul#LC_secondary_menu {
1.1075.2.23  raeburn  6726:   clear: right;
1.911     bisitz   6727:   color: $fontmenu;
                   6728:   background: $tabbg;
                   6729:   list-style: none;
                   6730:   padding: 0;
                   6731:   margin: 0;
                   6732:   width: 100%;
1.995     raeburn  6733:   text-align: left;
1.1075.2.4  raeburn  6734:   float: left;
1.808     droeschl 6735: }
                   6736: 
1.897     wenzelju 6737: ul#LC_secondary_menu li {
1.911     bisitz   6738:   font-weight: bold;
                   6739:   line-height: 1.8em;
                   6740:   border-right: 1px solid black;
                   6741:   vertical-align: middle;
1.1075.2.4  raeburn  6742:   float: left;
                   6743: }
                   6744: 
                   6745: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6746:   background-color: $data_table_light;
                   6747: }
                   6748: 
                   6749: ul#LC_secondary_menu li a {
                   6750:   padding: 0 0.8em;
                   6751: }
                   6752: 
                   6753: ul#LC_secondary_menu li ul {
                   6754:   display: none;
                   6755: }
                   6756: 
                   6757: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6758:   display: block;
                   6759:   position: absolute;
                   6760:   margin: 0;
                   6761:   padding: 0;
                   6762:   list-style:none;
                   6763:   float: none;
                   6764:   background-color: $data_table_light;
1.1075.2.5  raeburn  6765:   z-index: 2;
1.1075.2.10  raeburn  6766:   margin-left: -1px;
1.1075.2.4  raeburn  6767: }
                   6768: 
                   6769: ul#LC_secondary_menu li ul li {
                   6770:   font-size: 90%;
                   6771:   vertical-align: top;
                   6772:   border-left: 1px solid black;
                   6773:   border-right: 1px solid black;
1.1075.2.33  raeburn  6774:   background-color: $data_table_light;
1.1075.2.4  raeburn  6775:   list-style:none;
                   6776:   float: none;
                   6777: }
                   6778: 
                   6779: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6780:   background-color: $data_table_dark;
1.807     droeschl 6781: }
                   6782: 
1.847     tempelho 6783: ul.LC_TabContent {
1.911     bisitz   6784:   display:block;
                   6785:   background: $sidebg;
                   6786:   border-bottom: solid 1px $lg_border_color;
                   6787:   list-style:none;
1.1020    raeburn  6788:   margin: -1px -10px 0 -10px;
1.911     bisitz   6789:   padding: 0;
1.693     droeschl 6790: }
                   6791: 
1.795     www      6792: ul.LC_TabContent li,
                   6793: ul.LC_TabContentBigger li {
1.911     bisitz   6794:   float:left;
1.741     harmsja  6795: }
1.795     www      6796: 
1.897     wenzelju 6797: ul#LC_secondary_menu li a {
1.911     bisitz   6798:   color: $fontmenu;
                   6799:   text-decoration: none;
1.693     droeschl 6800: }
1.795     www      6801: 
1.721     harmsja  6802: ul.LC_TabContent {
1.952     onken    6803:   min-height:20px;
1.721     harmsja  6804: }
1.795     www      6805: 
                   6806: ul.LC_TabContent li {
1.911     bisitz   6807:   vertical-align:middle;
1.959     onken    6808:   padding: 0 16px 0 10px;
1.911     bisitz   6809:   background-color:$tabbg;
                   6810:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6811:   border-left: solid 1px $font;
1.721     harmsja  6812: }
1.795     www      6813: 
1.847     tempelho 6814: ul.LC_TabContent .right {
1.911     bisitz   6815:   float:right;
1.847     tempelho 6816: }
                   6817: 
1.911     bisitz   6818: ul.LC_TabContent li a,
                   6819: ul.LC_TabContent li {
                   6820:   color:rgb(47,47,47);
                   6821:   text-decoration:none;
                   6822:   font-size:95%;
                   6823:   font-weight:bold;
1.952     onken    6824:   min-height:20px;
                   6825: }
                   6826: 
1.959     onken    6827: ul.LC_TabContent li a:hover,
                   6828: ul.LC_TabContent li a:focus {
1.952     onken    6829:   color: $button_hover;
1.959     onken    6830:   background:none;
                   6831:   outline:none;
1.952     onken    6832: }
                   6833: 
                   6834: ul.LC_TabContent li:hover {
                   6835:   color: $button_hover;
                   6836:   cursor:pointer;
1.721     harmsja  6837: }
1.795     www      6838: 
1.911     bisitz   6839: ul.LC_TabContent li.active {
1.952     onken    6840:   color: $font;
1.911     bisitz   6841:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6842:   border-bottom:solid 1px #FFFFFF;
                   6843:   cursor: default;
1.744     ehlerst  6844: }
1.795     www      6845: 
1.959     onken    6846: ul.LC_TabContent li.active a {
                   6847:   color:$font;
                   6848:   background:#FFFFFF;
                   6849:   outline: none;
                   6850: }
1.1047    raeburn  6851: 
                   6852: ul.LC_TabContent li.goback {
                   6853:   float: left;
                   6854:   border-left: none;
                   6855: }
                   6856: 
1.870     tempelho 6857: #maincoursedoc {
1.911     bisitz   6858:   clear:both;
1.870     tempelho 6859: }
                   6860: 
                   6861: ul.LC_TabContentBigger {
1.911     bisitz   6862:   display:block;
                   6863:   list-style:none;
                   6864:   padding: 0;
1.870     tempelho 6865: }
                   6866: 
1.795     www      6867: ul.LC_TabContentBigger li {
1.911     bisitz   6868:   vertical-align:bottom;
                   6869:   height: 30px;
                   6870:   font-size:110%;
                   6871:   font-weight:bold;
                   6872:   color: #737373;
1.841     tempelho 6873: }
                   6874: 
1.957     onken    6875: ul.LC_TabContentBigger li.active {
                   6876:   position: relative;
                   6877:   top: 1px;
                   6878: }
                   6879: 
1.870     tempelho 6880: ul.LC_TabContentBigger li a {
1.911     bisitz   6881:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6882:   height: 30px;
                   6883:   line-height: 30px;
                   6884:   text-align: center;
                   6885:   display: block;
                   6886:   text-decoration: none;
1.958     onken    6887:   outline: none;  
1.741     harmsja  6888: }
1.795     www      6889: 
1.870     tempelho 6890: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6891:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6892:   color:$font;
1.744     ehlerst  6893: }
1.795     www      6894: 
1.870     tempelho 6895: ul.LC_TabContentBigger li b {
1.911     bisitz   6896:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6897:   display: block;
                   6898:   float: left;
                   6899:   padding: 0 30px;
1.957     onken    6900:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6901: }
                   6902: 
1.956     onken    6903: ul.LC_TabContentBigger li:hover b {
                   6904:   color:$button_hover;
                   6905: }
                   6906: 
1.870     tempelho 6907: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6908:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6909:   color:$font;
1.957     onken    6910:   border: 0;
1.741     harmsja  6911: }
1.693     droeschl 6912: 
1.870     tempelho 6913: 
1.862     bisitz   6914: ul.LC_CourseBreadcrumbs {
                   6915:   background: $sidebg;
1.1020    raeburn  6916:   height: 2em;
1.862     bisitz   6917:   padding-left: 10px;
1.1020    raeburn  6918:   margin: 0;
1.862     bisitz   6919:   list-style-position: inside;
                   6920: }
                   6921: 
1.911     bisitz   6922: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6923: ol#LC_PathBreadcrumbs {
1.911     bisitz   6924:   padding-left: 10px;
                   6925:   margin: 0;
1.933     droeschl 6926:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6927: }
                   6928: 
1.911     bisitz   6929: ol#LC_MenuBreadcrumbs li,
                   6930: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6931: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6932:   display: inline;
1.933     droeschl 6933:   white-space: normal;  
1.693     droeschl 6934: }
                   6935: 
1.823     bisitz   6936: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6937: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6938:   text-decoration: none;
                   6939:   font-size:90%;
1.693     droeschl 6940: }
1.795     www      6941: 
1.969     droeschl 6942: ol#LC_MenuBreadcrumbs h1 {
                   6943:   display: inline;
                   6944:   font-size: 90%;
                   6945:   line-height: 2.5em;
                   6946:   margin: 0;
                   6947:   padding: 0;
                   6948: }
                   6949: 
1.795     www      6950: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6951:   text-decoration:none;
                   6952:   font-size:100%;
                   6953:   font-weight:bold;
1.693     droeschl 6954: }
1.795     www      6955: 
1.840     bisitz   6956: .LC_Box {
1.911     bisitz   6957:   border: solid 1px $lg_border_color;
                   6958:   padding: 0 10px 10px 10px;
1.746     neumanie 6959: }
1.795     www      6960: 
1.1020    raeburn  6961: .LC_DocsBox {
                   6962:   border: solid 1px $lg_border_color;
                   6963:   padding: 0 0 10px 10px;
                   6964: }
                   6965: 
1.795     www      6966: .LC_AboutMe_Image {
1.911     bisitz   6967:   float:left;
                   6968:   margin-right:10px;
1.747     neumanie 6969: }
1.795     www      6970: 
                   6971: .LC_Clear_AboutMe_Image {
1.911     bisitz   6972:   clear:left;
1.747     neumanie 6973: }
1.795     www      6974: 
1.721     harmsja  6975: dl.LC_ListStyleClean dt {
1.911     bisitz   6976:   padding-right: 5px;
                   6977:   display: table-header-group;
1.693     droeschl 6978: }
                   6979: 
1.721     harmsja  6980: dl.LC_ListStyleClean dd {
1.911     bisitz   6981:   display: table-row;
1.693     droeschl 6982: }
                   6983: 
1.721     harmsja  6984: .LC_ListStyleClean,
                   6985: .LC_ListStyleSimple,
                   6986: .LC_ListStyleNormal,
1.795     www      6987: .LC_ListStyleSpecial {
1.911     bisitz   6988:   /* display:block; */
                   6989:   list-style-position: inside;
                   6990:   list-style-type: none;
                   6991:   overflow: hidden;
                   6992:   padding: 0;
1.693     droeschl 6993: }
                   6994: 
1.721     harmsja  6995: .LC_ListStyleSimple li,
                   6996: .LC_ListStyleSimple dd,
                   6997: .LC_ListStyleNormal li,
                   6998: .LC_ListStyleNormal dd,
                   6999: .LC_ListStyleSpecial li,
1.795     www      7000: .LC_ListStyleSpecial dd {
1.911     bisitz   7001:   margin: 0;
                   7002:   padding: 5px 5px 5px 10px;
                   7003:   clear: both;
1.693     droeschl 7004: }
                   7005: 
1.721     harmsja  7006: .LC_ListStyleClean li,
                   7007: .LC_ListStyleClean dd {
1.911     bisitz   7008:   padding-top: 0;
                   7009:   padding-bottom: 0;
1.693     droeschl 7010: }
                   7011: 
1.721     harmsja  7012: .LC_ListStyleSimple dd,
1.795     www      7013: .LC_ListStyleSimple li {
1.911     bisitz   7014:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7015: }
                   7016: 
1.721     harmsja  7017: .LC_ListStyleSpecial li,
                   7018: .LC_ListStyleSpecial dd {
1.911     bisitz   7019:   list-style-type: none;
                   7020:   background-color: RGB(220, 220, 220);
                   7021:   margin-bottom: 4px;
1.693     droeschl 7022: }
                   7023: 
1.721     harmsja  7024: table.LC_SimpleTable {
1.911     bisitz   7025:   margin:5px;
                   7026:   border:solid 1px $lg_border_color;
1.795     www      7027: }
1.693     droeschl 7028: 
1.721     harmsja  7029: table.LC_SimpleTable tr {
1.911     bisitz   7030:   padding: 0;
                   7031:   border:solid 1px $lg_border_color;
1.693     droeschl 7032: }
1.795     www      7033: 
                   7034: table.LC_SimpleTable thead {
1.911     bisitz   7035:   background:rgb(220,220,220);
1.693     droeschl 7036: }
                   7037: 
1.721     harmsja  7038: div.LC_columnSection {
1.911     bisitz   7039:   display: block;
                   7040:   clear: both;
                   7041:   overflow: hidden;
                   7042:   margin: 0;
1.693     droeschl 7043: }
                   7044: 
1.721     harmsja  7045: div.LC_columnSection>* {
1.911     bisitz   7046:   float: left;
                   7047:   margin: 10px 20px 10px 0;
                   7048:   overflow:hidden;
1.693     droeschl 7049: }
1.721     harmsja  7050: 
1.795     www      7051: table em {
1.911     bisitz   7052:   font-weight: bold;
                   7053:   font-style: normal;
1.748     schulted 7054: }
1.795     www      7055: 
1.779     bisitz   7056: table.LC_tableBrowseRes,
1.795     www      7057: table.LC_tableOfContent {
1.911     bisitz   7058:   border:none;
                   7059:   border-spacing: 1px;
                   7060:   padding: 3px;
                   7061:   background-color: #FFFFFF;
                   7062:   font-size: 90%;
1.753     droeschl 7063: }
1.789     droeschl 7064: 
1.911     bisitz   7065: table.LC_tableOfContent {
                   7066:   border-collapse: collapse;
1.789     droeschl 7067: }
                   7068: 
1.771     droeschl 7069: table.LC_tableBrowseRes a,
1.768     schulted 7070: table.LC_tableOfContent a {
1.911     bisitz   7071:   background-color: transparent;
                   7072:   text-decoration: none;
1.753     droeschl 7073: }
                   7074: 
1.795     www      7075: table.LC_tableOfContent img {
1.911     bisitz   7076:   border: none;
                   7077:   height: 1.3em;
                   7078:   vertical-align: text-bottom;
                   7079:   margin-right: 0.3em;
1.753     droeschl 7080: }
1.757     schulted 7081: 
1.795     www      7082: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7083:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7084: }
                   7085: 
1.795     www      7086: a#LC_content_toolbar_everything {
1.911     bisitz   7087:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7088: }
                   7089: 
1.795     www      7090: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7091:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7092: }
                   7093: 
1.795     www      7094: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7095:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7096: }
                   7097: 
1.795     www      7098: a#LC_content_toolbar_changefolder {
1.911     bisitz   7099:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7100: }
                   7101: 
1.795     www      7102: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7103:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7104: }
                   7105: 
1.1043    raeburn  7106: a#LC_content_toolbar_edittoplevel {
                   7107:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7108: }
                   7109: 
1.795     www      7110: ul#LC_toolbar li a:hover {
1.911     bisitz   7111:   background-position: bottom center;
1.757     schulted 7112: }
                   7113: 
1.795     www      7114: ul#LC_toolbar {
1.911     bisitz   7115:   padding: 0;
                   7116:   margin: 2px;
                   7117:   list-style:none;
                   7118:   position:relative;
                   7119:   background-color:white;
1.1075.2.9  raeburn  7120:   overflow: auto;
1.757     schulted 7121: }
                   7122: 
1.795     www      7123: ul#LC_toolbar li {
1.911     bisitz   7124:   border:1px solid white;
                   7125:   padding: 0;
                   7126:   margin: 0;
                   7127:   float: left;
                   7128:   display:inline;
                   7129:   vertical-align:middle;
1.1075.2.9  raeburn  7130:   white-space: nowrap;
1.911     bisitz   7131: }
1.757     schulted 7132: 
1.783     amueller 7133: 
1.795     www      7134: a.LC_toolbarItem {
1.911     bisitz   7135:   display:block;
                   7136:   padding: 0;
                   7137:   margin: 0;
                   7138:   height: 32px;
                   7139:   width: 32px;
                   7140:   color:white;
                   7141:   border: none;
                   7142:   background-repeat:no-repeat;
                   7143:   background-color:transparent;
1.757     schulted 7144: }
                   7145: 
1.915     droeschl 7146: ul.LC_funclist {
                   7147:     margin: 0;
                   7148:     padding: 0.5em 1em 0.5em 0;
                   7149: }
                   7150: 
1.933     droeschl 7151: ul.LC_funclist > li:first-child {
                   7152:     font-weight:bold; 
                   7153:     margin-left:0.8em;
                   7154: }
                   7155: 
1.915     droeschl 7156: ul.LC_funclist + ul.LC_funclist {
                   7157:     /* 
                   7158:        left border as a seperator if we have more than
                   7159:        one list 
                   7160:     */
                   7161:     border-left: 1px solid $sidebg;
                   7162:     /* 
                   7163:        this hides the left border behind the border of the 
                   7164:        outer box if element is wrapped to the next 'line' 
                   7165:     */
                   7166:     margin-left: -1px;
                   7167: }
                   7168: 
1.843     bisitz   7169: ul.LC_funclist li {
1.915     droeschl 7170:   display: inline;
1.782     bisitz   7171:   white-space: nowrap;
1.915     droeschl 7172:   margin: 0 0 0 25px;
                   7173:   line-height: 150%;
1.782     bisitz   7174: }
                   7175: 
1.974     wenzelju 7176: .LC_hidden {
                   7177:   display: none;
                   7178: }
                   7179: 
1.1030    www      7180: .LCmodal-overlay {
                   7181: 		position:fixed;
                   7182: 		top:0;
                   7183: 		right:0;
                   7184: 		bottom:0;
                   7185: 		left:0;
                   7186: 		height:100%;
                   7187: 		width:100%;
                   7188: 		margin:0;
                   7189: 		padding:0;
                   7190: 		background:#999;
                   7191: 		opacity:.75;
                   7192: 		filter: alpha(opacity=75);
                   7193: 		-moz-opacity: 0.75;
                   7194: 		z-index:101;
                   7195: }
                   7196: 
                   7197: * html .LCmodal-overlay {   
                   7198: 		position: absolute;
                   7199: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7200: }
                   7201: 
                   7202: .LCmodal-window {
                   7203: 		position:fixed;
                   7204: 		top:50%;
                   7205: 		left:50%;
                   7206: 		margin:0;
                   7207: 		padding:0;
                   7208: 		z-index:102;
                   7209: 	}
                   7210: 
                   7211: * html .LCmodal-window {
                   7212: 		position:absolute;
                   7213: }
                   7214: 
                   7215: .LCclose-window {
                   7216: 		position:absolute;
                   7217: 		width:32px;
                   7218: 		height:32px;
                   7219: 		right:8px;
                   7220: 		top:8px;
                   7221: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7222: 		text-indent:-99999px;
                   7223: 		overflow:hidden;
                   7224: 		cursor:pointer;
                   7225: }
                   7226: 
1.1075.2.17  raeburn  7227: /*
                   7228:   styles used by TTH when "Default set of options to pass to tth/m
                   7229:   when converting TeX" in course settings has been set
                   7230: 
                   7231:   option passed: -t
                   7232: 
                   7233: */
                   7234: 
                   7235: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7236: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7237: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7238: td div.norm {line-height:normal;}
                   7239: 
                   7240: /*
                   7241:   option passed -y3
                   7242: */
                   7243: 
                   7244: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7245: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7246: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7247: 
1.343     albertel 7248: END
                   7249: }
                   7250: 
1.306     albertel 7251: =pod
                   7252: 
                   7253: =item * &headtag()
                   7254: 
                   7255: Returns a uniform footer for LON-CAPA web pages.
                   7256: 
1.307     albertel 7257: Inputs: $title - optional title for the head
                   7258:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7259:         $args - optional arguments
1.319     albertel 7260:             force_register - if is true call registerurl so the remote is 
                   7261:                              informed
1.415     albertel 7262:             redirect       -> array ref of
                   7263:                                    1- seconds before redirect occurs
                   7264:                                    2- url to redirect to
                   7265:                                    3- whether the side effect should occur
1.315     albertel 7266:                            (side effect of setting 
                   7267:                                $env{'internal.head.redirect'} to the url 
                   7268:                                redirected too)
1.352     albertel 7269:             domain         -> force to color decorate a page for a specific
                   7270:                                domain
                   7271:             function       -> force usage of a specific rolish color scheme
                   7272:             bgcolor        -> override the default page bgcolor
1.460     albertel 7273:             no_auto_mt_title
                   7274:                            -> prevent &mt()ing the title arg
1.464     albertel 7275: 
1.306     albertel 7276: =cut
                   7277: 
                   7278: sub headtag {
1.313     albertel 7279:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7280:     
1.363     albertel 7281:     my $function = $args->{'function'} || &get_users_function();
                   7282:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7283:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1075.2.52  raeburn  7284:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7285:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7286: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7287: 		   #time(),
1.418     albertel 7288: 		   $env{'environment.color.timestamp'},
1.363     albertel 7289: 		   $function,$domain,$bgcolor);
                   7290: 
1.369     www      7291:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7292: 
1.308     albertel 7293:     my $result =
                   7294: 	'<head>'.
1.1075.2.56  raeburn  7295: 	&font_settings($args);
1.319     albertel 7296: 
1.1075.2.72  raeburn  7297:     my $inhibitprint;
                   7298:     if ($args->{'print_suppress'}) {
                   7299:         $inhibitprint = &print_suppression();
                   7300:     }
1.1064    raeburn  7301: 
1.461     albertel 7302:     if (!$args->{'frameset'}) {
                   7303: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7304:     }
1.1075.2.12  raeburn  7305:     if ($args->{'force_register'}) {
                   7306:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7307:     }
1.436     albertel 7308:     if (!$args->{'no_nav_bar'} 
                   7309: 	&& !$args->{'only_body'}
                   7310: 	&& !$args->{'frameset'}) {
1.1075.2.52  raeburn  7311: 	$result .= &help_menu_js($httphost);
1.1032    www      7312:         $result.=&modal_window();
1.1038    www      7313:         $result.=&togglebox_script();
1.1034    www      7314:         $result.=&wishlist_window();
1.1041    www      7315:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7316:     } else {
                   7317:         if ($args->{'add_modal'}) {
                   7318:            $result.=&modal_window();
                   7319:         }
                   7320:         if ($args->{'add_wishlist'}) {
                   7321:            $result.=&wishlist_window();
                   7322:         }
1.1038    www      7323:         if ($args->{'add_togglebox'}) {
                   7324:            $result.=&togglebox_script();
                   7325:         }
1.1041    www      7326:         if ($args->{'add_progressbar'}) {
                   7327:            $result.=&LCprogressbarUpdate_script();
                   7328:         }
1.436     albertel 7329:     }
1.314     albertel 7330:     if (ref($args->{'redirect'})) {
1.414     albertel 7331: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7332: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7333: 	if (!$inhibit_continue) {
                   7334: 	    $env{'internal.head.redirect'} = $url;
                   7335: 	}
1.313     albertel 7336: 	$result.=<<ADDMETA
                   7337: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7338: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7339: ADDMETA
                   7340:     }
1.306     albertel 7341:     if (!defined($title)) {
                   7342: 	$title = 'The LearningOnline Network with CAPA';
                   7343:     }
1.460     albertel 7344:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7345:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61  raeburn  7346: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7347:     if (!$args->{'frameset'}) {
                   7348:         $result .= ' /';
                   7349:     }
                   7350:     $result .= '>'
1.1064    raeburn  7351:         .$inhibitprint
1.414     albertel 7352: 	.$head_extra;
1.1075.2.42  raeburn  7353:     if ($env{'browser.mobile'}) {
                   7354:         $result .= '
                   7355: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7356: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7357:     }
1.962     droeschl 7358:     return $result.'</head>';
1.306     albertel 7359: }
                   7360: 
                   7361: =pod
                   7362: 
1.340     albertel 7363: =item * &font_settings()
                   7364: 
                   7365: Returns neccessary <meta> to set the proper encoding
                   7366: 
1.1075.2.56  raeburn  7367: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 7368: 
                   7369: =cut
                   7370: 
                   7371: sub font_settings {
1.1075.2.56  raeburn  7372:     my ($args) = @_;
1.340     albertel 7373:     my $headerstring='';
1.1075.2.56  raeburn  7374:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   7375:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340     albertel 7376: 	$headerstring.=
1.1075.2.61  raeburn  7377: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   7378:         if (!$args->{'frameset'}) {
                   7379:             $headerstring.= ' /';
                   7380:         }
                   7381:         $headerstring .= '>'."\n";
1.340     albertel 7382:     }
                   7383:     return $headerstring;
                   7384: }
                   7385: 
1.341     albertel 7386: =pod
                   7387: 
1.1064    raeburn  7388: =item * &print_suppression()
                   7389: 
                   7390: In course context returns css which causes the body to be blank when media="print",
                   7391: if printout generation is unavailable for the current resource.
                   7392: 
                   7393: This could be because:
                   7394: 
                   7395: (a) printstartdate is in the future
                   7396: 
                   7397: (b) printenddate is in the past
                   7398: 
                   7399: (c) there is an active exam block with "printout"
                   7400: functionality blocked
                   7401: 
                   7402: Users with pav, pfo or evb privileges are exempt.
                   7403: 
                   7404: Inputs: none
                   7405: 
                   7406: =cut
                   7407: 
                   7408: 
                   7409: sub print_suppression {
                   7410:     my $noprint;
                   7411:     if ($env{'request.course.id'}) {
                   7412:         my $scope = $env{'request.course.id'};
                   7413:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7414:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7415:             return;
                   7416:         }
                   7417:         if ($env{'request.course.sec'} ne '') {
                   7418:             $scope .= "/$env{'request.course.sec'}";
                   7419:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7420:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7421:                 return;
1.1064    raeburn  7422:             }
                   7423:         }
                   7424:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7425:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.73  raeburn  7426:         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064    raeburn  7427:         if ($blocked) {
                   7428:             my $checkrole = "cm./$cdom/$cnum";
                   7429:             if ($env{'request.course.sec'} ne '') {
                   7430:                 $checkrole .= "/$env{'request.course.sec'}";
                   7431:             }
                   7432:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7433:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7434:                 $noprint = 1;
                   7435:             }
                   7436:         }
                   7437:         unless ($noprint) {
                   7438:             my $symb = &Apache::lonnet::symbread();
                   7439:             if ($symb ne '') {
                   7440:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7441:                 if (ref($navmap)) {
                   7442:                     my $res = $navmap->getBySymb($symb);
                   7443:                     if (ref($res)) {
                   7444:                         if (!$res->resprintable()) {
                   7445:                             $noprint = 1;
                   7446:                         }
                   7447:                     }
                   7448:                 }
                   7449:             }
                   7450:         }
                   7451:         if ($noprint) {
                   7452:             return <<"ENDSTYLE";
                   7453: <style type="text/css" media="print">
                   7454:     body { display:none }
                   7455: </style>
                   7456: ENDSTYLE
                   7457:         }
                   7458:     }
                   7459:     return;
                   7460: }
                   7461: 
                   7462: =pod
                   7463: 
1.341     albertel 7464: =item * &xml_begin()
                   7465: 
                   7466: Returns the needed doctype and <html>
                   7467: 
                   7468: Inputs: none
                   7469: 
                   7470: =cut
                   7471: 
                   7472: sub xml_begin {
1.1075.2.61  raeburn  7473:     my ($is_frameset) = @_;
1.341     albertel 7474:     my $output='';
                   7475: 
                   7476:     if ($env{'browser.mathml'}) {
                   7477: 	$output='<?xml version="1.0"?>'
                   7478:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7479: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7480:             
                   7481: #	    .'<!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">] >'
                   7482: 	    .'<!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">'
                   7483:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7484: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61  raeburn  7485:     } elsif ($is_frameset) {
                   7486:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   7487:                 '<html>'."\n";
1.341     albertel 7488:     } else {
1.1075.2.61  raeburn  7489: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   7490:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 7491:     }
                   7492:     return $output;
                   7493: }
1.340     albertel 7494: 
                   7495: =pod
                   7496: 
1.306     albertel 7497: =item * &start_page()
                   7498: 
                   7499: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7500: 
1.648     raeburn  7501: Inputs:
                   7502: 
                   7503: =over 4
                   7504: 
                   7505: $title - optional title for the page
                   7506: 
                   7507: $head_extra - optional extra HTML to incude inside the <head>
                   7508: 
                   7509: $args - additional optional args supported are:
                   7510: 
                   7511: =over 8
                   7512: 
                   7513:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7514:                                     arg on
1.814     bisitz   7515:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7516:              add_entries    -> additional attributes to add to the  <body>
                   7517:              domain         -> force to color decorate a page for a 
1.317     albertel 7518:                                     specific domain
1.648     raeburn  7519:              function       -> force usage of a specific rolish color
1.317     albertel 7520:                                     scheme
1.648     raeburn  7521:              redirect       -> see &headtag()
                   7522:              bgcolor        -> override the default page bg color
                   7523:              js_ready       -> return a string ready for being used in 
1.317     albertel 7524:                                     a javascript writeln
1.648     raeburn  7525:              html_encode    -> return a string ready for being used in 
1.320     albertel 7526:                                     a html attribute
1.648     raeburn  7527:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7528:                                     $forcereg arg
1.648     raeburn  7529:              frameset       -> if true will start with a <frameset>
1.330     albertel 7530:                                     rather than <body>
1.648     raeburn  7531:              skip_phases    -> hash ref of 
1.338     albertel 7532:                                     head -> skip the <html><head> generation
                   7533:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  7534:              no_inline_link -> if true and in remote mode, don't show the
                   7535:                                     'Switch To Inline Menu' link
1.648     raeburn  7536:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7537:              inherit_jsmath -> when creating popup window in a page,
                   7538:                                     should it have jsmath forced on by the
                   7539:                                     current page
1.867     kalberla 7540:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7541:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.15  raeburn  7542:              group          -> includes the current group, if page is for a
                   7543:                                specific group
1.361     albertel 7544: 
1.648     raeburn  7545: =back
1.460     albertel 7546: 
1.648     raeburn  7547: =back
1.562     albertel 7548: 
1.306     albertel 7549: =cut
                   7550: 
                   7551: sub start_page {
1.309     albertel 7552:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7553:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7554: 
1.315     albertel 7555:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  7556:     my ($result,@advtools);
1.964     droeschl 7557: 
1.338     albertel 7558:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62  raeburn  7559:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 7560:     }
                   7561:     
                   7562:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7563: 	if ($args->{'frameset'}) {
                   7564: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7565: 						$args->{'add_entries'});
                   7566: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7567:         } else {
                   7568:             $result .=
                   7569:                 &bodytag($title, 
                   7570:                          $args->{'function'},       $args->{'add_entries'},
                   7571:                          $args->{'only_body'},      $args->{'domain'},
                   7572:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  7573:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  7574:                          $args,                     \@advtools);
1.831     bisitz   7575:         }
1.330     albertel 7576:     }
1.338     albertel 7577: 
1.315     albertel 7578:     if ($args->{'js_ready'}) {
1.713     kaisler  7579: 		$result = &js_ready($result);
1.315     albertel 7580:     }
1.320     albertel 7581:     if ($args->{'html_encode'}) {
1.713     kaisler  7582: 		$result = &html_encode($result);
                   7583:     }
                   7584: 
1.813     bisitz   7585:     # Preparation for new and consistent functionlist at top of screen
                   7586:     # if ($args->{'functionlist'}) {
                   7587:     #            $result .= &build_functionlist();
                   7588:     #}
                   7589: 
1.964     droeschl 7590:     # Don't add anything more if only_body wanted or in const space
                   7591:     return $result if    $args->{'only_body'} 
                   7592:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7593: 
                   7594:     #Breadcrumbs
1.758     kaisler  7595:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7596: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7597: 		#if any br links exists, add them to the breadcrumbs
                   7598: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7599: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7600: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7601: 			}
                   7602: 		}
1.1075.2.19  raeburn  7603:                 # if @advtools array contains items add then to the breadcrumbs
                   7604:                 if (@advtools > 0) {
                   7605:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7606:                 }
1.758     kaisler  7607: 
                   7608: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7609: 		if(exists($args->{'bread_crumbs_component'})){
                   7610: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7611: 		}else{
                   7612: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7613: 		}
1.1075.2.24  raeburn  7614:     } elsif (($env{'environment.remote'} eq 'on') &&
                   7615:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   7616:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   7617:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  7618:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 7619:     }
1.315     albertel 7620:     return $result;
1.306     albertel 7621: }
                   7622: 
                   7623: sub end_page {
1.315     albertel 7624:     my ($args) = @_;
                   7625:     $env{'internal.end_page'}++;
1.330     albertel 7626:     my $result;
1.335     albertel 7627:     if ($args->{'discussion'}) {
                   7628: 	my ($target,$parser);
                   7629: 	if (ref($args->{'discussion'})) {
                   7630: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7631: 				$args->{'discussion'}{'parser'});
                   7632: 	}
                   7633: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7634:     }
1.330     albertel 7635:     if ($args->{'frameset'}) {
                   7636: 	$result .= '</frameset>';
                   7637:     } else {
1.635     raeburn  7638: 	$result .= &endbodytag($args);
1.330     albertel 7639:     }
1.1075.2.6  raeburn  7640:     unless ($args->{'notbody'}) {
                   7641:         $result .= "\n</html>";
                   7642:     }
1.330     albertel 7643: 
1.315     albertel 7644:     if ($args->{'js_ready'}) {
1.317     albertel 7645: 	$result = &js_ready($result);
1.315     albertel 7646:     }
1.335     albertel 7647: 
1.320     albertel 7648:     if ($args->{'html_encode'}) {
                   7649: 	$result = &html_encode($result);
                   7650:     }
1.335     albertel 7651: 
1.315     albertel 7652:     return $result;
                   7653: }
                   7654: 
1.1034    www      7655: sub wishlist_window {
                   7656:     return(<<'ENDWISHLIST');
1.1046    raeburn  7657: <script type="text/javascript">
1.1034    www      7658: // <![CDATA[
                   7659: // <!-- BEGIN LON-CAPA Internal
                   7660: function set_wishlistlink(title, path) {
                   7661:     if (!title) {
                   7662:         title = document.title;
                   7663:         title = title.replace(/^LON-CAPA /,'');
                   7664:     }
1.1075.2.65  raeburn  7665:     title = encodeURIComponent(title);
1.1034    www      7666:     if (!path) {
                   7667:         path = location.pathname;
                   7668:     }
1.1075.2.65  raeburn  7669:     path = encodeURIComponent(path);
1.1034    www      7670:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7671:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7672: }
                   7673: // END LON-CAPA Internal -->
                   7674: // ]]>
                   7675: </script>
                   7676: ENDWISHLIST
                   7677: }
                   7678: 
1.1030    www      7679: sub modal_window {
                   7680:     return(<<'ENDMODAL');
1.1046    raeburn  7681: <script type="text/javascript">
1.1030    www      7682: // <![CDATA[
                   7683: // <!-- BEGIN LON-CAPA Internal
                   7684: var modalWindow = {
                   7685: 	parent:"body",
                   7686: 	windowId:null,
                   7687: 	content:null,
                   7688: 	width:null,
                   7689: 	height:null,
                   7690: 	close:function()
                   7691: 	{
                   7692: 	        $(".LCmodal-window").remove();
                   7693: 	        $(".LCmodal-overlay").remove();
                   7694: 	},
                   7695: 	open:function()
                   7696: 	{
                   7697: 		var modal = "";
                   7698: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7699: 		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;\">";
                   7700: 		modal += this.content;
                   7701: 		modal += "</div>";	
                   7702: 
                   7703: 		$(this.parent).append(modal);
                   7704: 
                   7705: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7706: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7707: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7708: 	}
                   7709: };
1.1075.2.42  raeburn  7710: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      7711: 	{
                   7712: 		modalWindow.windowId = "myModal";
                   7713: 		modalWindow.width = width;
                   7714: 		modalWindow.height = height;
1.1075.2.42  raeburn  7715: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'>&lt/iframe>";
1.1030    www      7716: 		modalWindow.open();
                   7717: 	};	
                   7718: // END LON-CAPA Internal -->
                   7719: // ]]>
                   7720: </script>
                   7721: ENDMODAL
                   7722: }
                   7723: 
                   7724: sub modal_link {
1.1075.2.42  raeburn  7725:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      7726:     unless ($width) { $width=480; }
                   7727:     unless ($height) { $height=400; }
1.1031    www      7728:     unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42  raeburn  7729:     unless ($transparency) { $transparency='true'; }
                   7730: 
1.1074    raeburn  7731:     my $target_attr;
                   7732:     if (defined($target)) {
                   7733:         $target_attr = 'target="'.$target.'"';
                   7734:     }
                   7735:     return <<"ENDLINK";
1.1075.2.42  raeburn  7736: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  7737:            $linktext</a>
                   7738: ENDLINK
1.1030    www      7739: }
                   7740: 
1.1032    www      7741: sub modal_adhoc_script {
                   7742:     my ($funcname,$width,$height,$content)=@_;
                   7743:     return (<<ENDADHOC);
1.1046    raeburn  7744: <script type="text/javascript">
1.1032    www      7745: // <![CDATA[
                   7746:         var $funcname = function()
                   7747:         {
                   7748:                 modalWindow.windowId = "myModal";
                   7749:                 modalWindow.width = $width;
                   7750:                 modalWindow.height = $height;
                   7751:                 modalWindow.content = '$content';
                   7752:                 modalWindow.open();
                   7753:         };  
                   7754: // ]]>
                   7755: </script>
                   7756: ENDADHOC
                   7757: }
                   7758: 
1.1041    www      7759: sub modal_adhoc_inner {
                   7760:     my ($funcname,$width,$height,$content)=@_;
                   7761:     my $innerwidth=$width-20;
                   7762:     $content=&js_ready(
1.1042    www      7763:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42  raeburn  7764:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   7765:                  $content.
1.1041    www      7766:                  &end_scrollbox().
1.1075.2.42  raeburn  7767:                  &end_page()
1.1041    www      7768:              );
                   7769:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7770: }
                   7771: 
                   7772: sub modal_adhoc_window {
                   7773:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7774:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7775:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7776: }
                   7777: 
                   7778: sub modal_adhoc_launch {
                   7779:     my ($funcname,$width,$height,$content)=@_;
                   7780:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7781: <script type="text/javascript">
                   7782: // <![CDATA[
                   7783: $funcname();
                   7784: // ]]>
                   7785: </script>
                   7786: ENDLAUNCH
                   7787: }
                   7788: 
                   7789: sub modal_adhoc_close {
                   7790:     return (<<ENDCLOSE);
                   7791: <script type="text/javascript">
                   7792: // <![CDATA[
                   7793: modalWindow.close();
                   7794: // ]]>
                   7795: </script>
                   7796: ENDCLOSE
                   7797: }
                   7798: 
1.1038    www      7799: sub togglebox_script {
                   7800:    return(<<ENDTOGGLE);
                   7801: <script type="text/javascript"> 
                   7802: // <![CDATA[
                   7803: function LCtoggleDisplay(id,hidetext,showtext) {
                   7804:    link = document.getElementById(id + "link").childNodes[0];
                   7805:    with (document.getElementById(id).style) {
                   7806:       if (display == "none" ) {
                   7807:           display = "inline";
                   7808:           link.nodeValue = hidetext;
                   7809:         } else {
                   7810:           display = "none";
                   7811:           link.nodeValue = showtext;
                   7812:        }
                   7813:    }
                   7814: }
                   7815: // ]]>
                   7816: </script>
                   7817: ENDTOGGLE
                   7818: }
                   7819: 
1.1039    www      7820: sub start_togglebox {
                   7821:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7822:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7823:     unless ($showtext) { $showtext=&mt('show'); }
                   7824:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7825:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7826:     return &start_data_table().
                   7827:            &start_data_table_header_row().
                   7828:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7829:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7830:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7831:            &end_data_table_header_row().
                   7832:            '<tr id="'.$id.'" style="display:none""><td>';
                   7833: }
                   7834: 
                   7835: sub end_togglebox {
                   7836:     return '</td></tr>'.&end_data_table();
                   7837: }
                   7838: 
1.1041    www      7839: sub LCprogressbar_script {
1.1045    www      7840:    my ($id)=@_;
1.1041    www      7841:    return(<<ENDPROGRESS);
                   7842: <script type="text/javascript">
                   7843: // <![CDATA[
1.1045    www      7844: \$('#progressbar$id').progressbar({
1.1041    www      7845:   value: 0,
                   7846:   change: function(event, ui) {
                   7847:     var newVal = \$(this).progressbar('option', 'value');
                   7848:     \$('.pblabel', this).text(LCprogressTxt);
                   7849:   }
                   7850: });
                   7851: // ]]>
                   7852: </script>
                   7853: ENDPROGRESS
                   7854: }
                   7855: 
                   7856: sub LCprogressbarUpdate_script {
                   7857:    return(<<ENDPROGRESSUPDATE);
                   7858: <style type="text/css">
                   7859: .ui-progressbar { position:relative; }
                   7860: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7861: </style>
                   7862: <script type="text/javascript">
                   7863: // <![CDATA[
1.1045    www      7864: var LCprogressTxt='---';
                   7865: 
                   7866: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7867:    LCprogressTxt=progresstext;
1.1045    www      7868:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7869: }
                   7870: // ]]>
                   7871: </script>
                   7872: ENDPROGRESSUPDATE
                   7873: }
                   7874: 
1.1042    www      7875: my $LClastpercent;
1.1045    www      7876: my $LCidcnt;
                   7877: my $LCcurrentid;
1.1042    www      7878: 
1.1041    www      7879: sub LCprogressbar {
1.1042    www      7880:     my ($r)=(@_);
                   7881:     $LClastpercent=0;
1.1045    www      7882:     $LCidcnt++;
                   7883:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7884:     my $starting=&mt('Starting');
                   7885:     my $content=(<<ENDPROGBAR);
1.1045    www      7886:   <div id="progressbar$LCcurrentid">
1.1041    www      7887:     <span class="pblabel">$starting</span>
                   7888:   </div>
                   7889: ENDPROGBAR
1.1045    www      7890:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7891: }
                   7892: 
                   7893: sub LCprogressbarUpdate {
1.1042    www      7894:     my ($r,$val,$text)=@_;
                   7895:     unless ($val) { 
                   7896:        if ($LClastpercent) {
                   7897:            $val=$LClastpercent;
                   7898:        } else {
                   7899:            $val=0;
                   7900:        }
                   7901:     }
1.1041    www      7902:     if ($val<0) { $val=0; }
                   7903:     if ($val>100) { $val=0; }
1.1042    www      7904:     $LClastpercent=$val;
1.1041    www      7905:     unless ($text) { $text=$val.'%'; }
                   7906:     $text=&js_ready($text);
1.1044    www      7907:     &r_print($r,<<ENDUPDATE);
1.1041    www      7908: <script type="text/javascript">
                   7909: // <![CDATA[
1.1045    www      7910: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7911: // ]]>
                   7912: </script>
                   7913: ENDUPDATE
1.1035    www      7914: }
                   7915: 
1.1042    www      7916: sub LCprogressbarClose {
                   7917:     my ($r)=@_;
                   7918:     $LClastpercent=0;
1.1044    www      7919:     &r_print($r,<<ENDCLOSE);
1.1042    www      7920: <script type="text/javascript">
                   7921: // <![CDATA[
1.1045    www      7922: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7923: // ]]>
                   7924: </script>
                   7925: ENDCLOSE
1.1044    www      7926: }
                   7927: 
                   7928: sub r_print {
                   7929:     my ($r,$to_print)=@_;
                   7930:     if ($r) {
                   7931:       $r->print($to_print);
                   7932:       $r->rflush();
                   7933:     } else {
                   7934:       print($to_print);
                   7935:     }
1.1042    www      7936: }
                   7937: 
1.320     albertel 7938: sub html_encode {
                   7939:     my ($result) = @_;
                   7940: 
1.322     albertel 7941:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7942:     
                   7943:     return $result;
                   7944: }
1.1044    www      7945: 
1.317     albertel 7946: sub js_ready {
                   7947:     my ($result) = @_;
                   7948: 
1.323     albertel 7949:     $result =~ s/[\n\r]/ /xmsg;
                   7950:     $result =~ s/\\/\\\\/xmsg;
                   7951:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7952:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7953:     
                   7954:     return $result;
                   7955: }
                   7956: 
1.315     albertel 7957: sub validate_page {
                   7958:     if (  exists($env{'internal.start_page'})
1.316     albertel 7959: 	  &&     $env{'internal.start_page'} > 1) {
                   7960: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7961: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7962: 				 $ENV{'request.filename'});
1.315     albertel 7963:     }
                   7964:     if (  exists($env{'internal.end_page'})
1.316     albertel 7965: 	  &&     $env{'internal.end_page'} > 1) {
                   7966: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7967: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7968: 				 $env{'request.filename'});
1.315     albertel 7969:     }
                   7970:     if (     exists($env{'internal.start_page'})
                   7971: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7972: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7973: 				 $env{'request.filename'});
1.315     albertel 7974:     }
                   7975:     if (   ! exists($env{'internal.start_page'})
                   7976: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7977: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7978: 				 $env{'request.filename'});
1.315     albertel 7979:     }
1.306     albertel 7980: }
1.315     albertel 7981: 
1.996     www      7982: 
                   7983: sub start_scrollbox {
1.1075.2.56  raeburn  7984:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  7985:     unless ($outerwidth) { $outerwidth='520px'; }
                   7986:     unless ($width) { $width='500px'; }
                   7987:     unless ($height) { $height='200px'; }
1.1075    raeburn  7988:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  7989:     if ($id ne '') {
1.1075.2.42  raeburn  7990:         $table_id = ' id="table_'.$id.'"';
                   7991:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  7992:     }
1.1075    raeburn  7993:     if ($bgcolor ne '') {
                   7994:         $tdcol = "background-color: $bgcolor;";
                   7995:     }
1.1075.2.42  raeburn  7996:     my $nicescroll_js;
                   7997:     if ($env{'browser.mobile'}) {
                   7998:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   7999:     }
1.1075    raeburn  8000:     return <<"END";
1.1075.2.42  raeburn  8001: $nicescroll_js
                   8002: 
                   8003: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56  raeburn  8004: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075    raeburn  8005: END
1.996     www      8006: }
                   8007: 
                   8008: sub end_scrollbox {
1.1036    www      8009:     return '</div></td></tr></table>';
1.996     www      8010: }
                   8011: 
1.1075.2.42  raeburn  8012: sub nicescroll_javascript {
                   8013:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8014:     my %options;
                   8015:     if (ref($cursor) eq 'HASH') {
                   8016:         %options = %{$cursor};
                   8017:     }
                   8018:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8019:         $options{'railalign'} = 'left';
                   8020:     }
                   8021:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8022:         my $function  = &get_users_function();
                   8023:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
                   8024:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8025:             $options{'cursorcolor'} = '#00F';
                   8026:         }
                   8027:     }
                   8028:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8029:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
                   8030:             $options{'cursoropacity'}='1.0';
                   8031:         }
                   8032:     } else {
                   8033:         $options{'cursoropacity'}='1.0';
                   8034:     }
                   8035:     if ($options{'cursorfixedheight'} eq 'none') {
                   8036:         delete($options{'cursorfixedheight'});
                   8037:     } else {
                   8038:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8039:     }
                   8040:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8041:         delete($options{'railoffset'});
                   8042:     }
                   8043:     my @niceoptions;
                   8044:     while (my($key,$value) = each(%options)) {
                   8045:         if ($value =~ /^\{.+\}$/) {
                   8046:             push(@niceoptions,$key.':'.$value);
                   8047:         } else {
                   8048:             push(@niceoptions,$key.':"'.$value.'"');
                   8049:         }
                   8050:     }
                   8051:     my $nicescroll_js = '
                   8052: $(document).ready(
                   8053:       function() {
                   8054:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8055:       }
                   8056: );
                   8057: ';
                   8058:     if ($framecheck) {
                   8059:         $nicescroll_js .= '
                   8060: function expand_div(caller) {
                   8061:     if (top === self) {
                   8062:         document.getElementById("'.$id.'").style.width = "auto";
                   8063:         document.getElementById("'.$id.'").style.height = "auto";
                   8064:     } else {
                   8065:         try {
                   8066:             if (parent.frames) {
                   8067:                 if (parent.frames.length > 1) {
                   8068:                     var framesrc = parent.frames[1].location.href;
                   8069:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8070:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8071:                         document.getElementById("'.$id.'").style.width = "auto";
                   8072:                         document.getElementById("'.$id.'").style.height = "auto";
                   8073:                     }
                   8074:                 }
                   8075:             }
                   8076:         } catch (e) {
                   8077:             return;
                   8078:         }
                   8079:     }
                   8080:     return;
                   8081: }
                   8082: ';
                   8083:     }
                   8084:     if ($needjsready) {
                   8085:         $nicescroll_js = '
                   8086: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8087:     } else {
                   8088:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8089:     }
                   8090:     return $nicescroll_js;
                   8091: }
                   8092: 
1.318     albertel 8093: sub simple_error_page {
1.1075.2.49  raeburn  8094:     my ($r,$title,$msg,$args) = @_;
                   8095:     if (ref($args) eq 'HASH') {
                   8096:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8097:     } else {
                   8098:         $msg = &mt($msg);
                   8099:     }
                   8100: 
1.318     albertel 8101:     my $page =
                   8102: 	&Apache::loncommon::start_page($title).
1.1075.2.49  raeburn  8103: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8104: 	&Apache::loncommon::end_page();
                   8105:     if (ref($r)) {
                   8106: 	$r->print($page);
1.327     albertel 8107: 	return;
1.318     albertel 8108:     }
                   8109:     return $page;
                   8110: }
1.347     albertel 8111: 
                   8112: {
1.610     albertel 8113:     my @row_count;
1.961     onken    8114: 
                   8115:     sub start_data_table_count {
                   8116:         unshift(@row_count, 0);
                   8117:         return;
                   8118:     }
                   8119: 
                   8120:     sub end_data_table_count {
                   8121:         shift(@row_count);
                   8122:         return;
                   8123:     }
                   8124: 
1.347     albertel 8125:     sub start_data_table {
1.1018    raeburn  8126: 	my ($add_class,$id) = @_;
1.422     albertel 8127: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8128:         my $table_id;
                   8129:         if (defined($id)) {
                   8130:             $table_id = ' id="'.$id.'"';
                   8131:         }
1.961     onken    8132: 	&start_data_table_count();
1.1018    raeburn  8133: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8134:     }
                   8135: 
                   8136:     sub end_data_table {
1.961     onken    8137: 	&end_data_table_count();
1.389     albertel 8138: 	return '</table>'."\n";;
1.347     albertel 8139:     }
                   8140: 
                   8141:     sub start_data_table_row {
1.974     wenzelju 8142: 	my ($add_class, $id) = @_;
1.610     albertel 8143: 	$row_count[0]++;
                   8144: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8145: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8146:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8147:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8148:     }
1.471     banghart 8149:     
                   8150:     sub continue_data_table_row {
1.974     wenzelju 8151: 	my ($add_class, $id) = @_;
1.610     albertel 8152: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8153: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8154:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8155:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8156:     }
1.347     albertel 8157: 
                   8158:     sub end_data_table_row {
1.389     albertel 8159: 	return '</tr>'."\n";;
1.347     albertel 8160:     }
1.367     www      8161: 
1.421     albertel 8162:     sub start_data_table_empty_row {
1.707     bisitz   8163: #	$row_count[0]++;
1.421     albertel 8164: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8165:     }
                   8166: 
                   8167:     sub end_data_table_empty_row {
                   8168: 	return '</tr>'."\n";;
                   8169:     }
                   8170: 
1.367     www      8171:     sub start_data_table_header_row {
1.389     albertel 8172: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8173:     }
                   8174: 
                   8175:     sub end_data_table_header_row {
1.389     albertel 8176: 	return '</tr>'."\n";;
1.367     www      8177:     }
1.890     droeschl 8178: 
                   8179:     sub data_table_caption {
                   8180:         my $caption = shift;
                   8181:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8182:     }
1.347     albertel 8183: }
                   8184: 
1.548     albertel 8185: =pod
                   8186: 
                   8187: =item * &inhibit_menu_check($arg)
                   8188: 
                   8189: Checks for a inhibitmenu state and generates output to preserve it
                   8190: 
                   8191: Inputs:         $arg - can be any of
                   8192:                      - undef - in which case the return value is a string 
                   8193:                                to add  into arguments list of a uri
                   8194:                      - 'input' - in which case the return value is a HTML
                   8195:                                  <form> <input> field of type hidden to
                   8196:                                  preserve the value
                   8197:                      - a url - in which case the return value is the url with
                   8198:                                the neccesary cgi args added to preserve the
                   8199:                                inhibitmenu state
                   8200:                      - a ref to a url - no return value, but the string is
                   8201:                                         updated to include the neccessary cgi
                   8202:                                         args to preserve the inhibitmenu state
                   8203: 
                   8204: =cut
                   8205: 
                   8206: sub inhibit_menu_check {
                   8207:     my ($arg) = @_;
                   8208:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8209:     if ($arg eq 'input') {
                   8210: 	if ($env{'form.inhibitmenu'}) {
                   8211: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8212: 	} else {
                   8213: 	    return
                   8214: 	}
                   8215:     }
                   8216:     if ($env{'form.inhibitmenu'}) {
                   8217: 	if (ref($arg)) {
                   8218: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8219: 	} elsif ($arg eq '') {
                   8220: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8221: 	} else {
                   8222: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8223: 	}
                   8224:     }
                   8225:     if (!ref($arg)) {
                   8226: 	return $arg;
                   8227:     }
                   8228: }
                   8229: 
1.251     albertel 8230: ###############################################
1.182     matthew  8231: 
                   8232: =pod
                   8233: 
1.549     albertel 8234: =back
                   8235: 
                   8236: =head1 User Information Routines
                   8237: 
                   8238: =over 4
                   8239: 
1.405     albertel 8240: =item * &get_users_function()
1.182     matthew  8241: 
                   8242: Used by &bodytag to determine the current users primary role.
                   8243: Returns either 'student','coordinator','admin', or 'author'.
                   8244: 
                   8245: =cut
                   8246: 
                   8247: ###############################################
                   8248: sub get_users_function {
1.815     tempelho 8249:     my $function = 'norole';
1.818     tempelho 8250:     if ($env{'request.role'}=~/^(st)/) {
                   8251:         $function='student';
                   8252:     }
1.907     raeburn  8253:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8254:         $function='coordinator';
                   8255:     }
1.258     albertel 8256:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8257:         $function='admin';
                   8258:     }
1.826     bisitz   8259:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8260:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8261:         $function='author';
                   8262:     }
                   8263:     return $function;
1.54      www      8264: }
1.99      www      8265: 
                   8266: ###############################################
                   8267: 
1.233     raeburn  8268: =pod
                   8269: 
1.821     raeburn  8270: =item * &show_course()
                   8271: 
                   8272: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8273: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8274: 
                   8275: Inputs:
                   8276: None
                   8277: 
                   8278: Outputs:
                   8279: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8280: 
                   8281: =cut
                   8282: 
                   8283: ###############################################
                   8284: sub show_course {
                   8285:     my $course = !$env{'user.adv'};
                   8286:     if (!$env{'user.adv'}) {
                   8287:         foreach my $env (keys(%env)) {
                   8288:             next if ($env !~ m/^user\.priv\./);
                   8289:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8290:                 $course = 0;
                   8291:                 last;
                   8292:             }
                   8293:         }
                   8294:     }
                   8295:     return $course;
                   8296: }
                   8297: 
                   8298: ###############################################
                   8299: 
                   8300: =pod
                   8301: 
1.542     raeburn  8302: =item * &check_user_status()
1.274     raeburn  8303: 
                   8304: Determines current status of supplied role for a
                   8305: specific user. Roles can be active, previous or future.
                   8306: 
                   8307: Inputs: 
                   8308: user's domain, user's username, course's domain,
1.375     raeburn  8309: course's number, optional section ID.
1.274     raeburn  8310: 
                   8311: Outputs:
                   8312: role status: active, previous or future. 
                   8313: 
                   8314: =cut
                   8315: 
                   8316: sub check_user_status {
1.412     raeburn  8317:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8318:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8319:     my @uroles = keys %userinfo;
                   8320:     my $srchstr;
                   8321:     my $active_chk = 'none';
1.412     raeburn  8322:     my $now = time;
1.274     raeburn  8323:     if (@uroles > 0) {
1.908     raeburn  8324:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8325:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8326:         } else {
1.412     raeburn  8327:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8328:         }
                   8329:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8330:             my $role_end = 0;
                   8331:             my $role_start = 0;
                   8332:             $active_chk = 'active';
1.412     raeburn  8333:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8334:                 $role_end = $1;
                   8335:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8336:                     $role_start = $1;
1.274     raeburn  8337:                 }
                   8338:             }
                   8339:             if ($role_start > 0) {
1.412     raeburn  8340:                 if ($now < $role_start) {
1.274     raeburn  8341:                     $active_chk = 'future';
                   8342:                 }
                   8343:             }
                   8344:             if ($role_end > 0) {
1.412     raeburn  8345:                 if ($now > $role_end) {
1.274     raeburn  8346:                     $active_chk = 'previous';
                   8347:                 }
                   8348:             }
                   8349:         }
                   8350:     }
                   8351:     return $active_chk;
                   8352: }
                   8353: 
                   8354: ###############################################
                   8355: 
                   8356: =pod
                   8357: 
1.405     albertel 8358: =item * &get_sections()
1.233     raeburn  8359: 
                   8360: Determines all the sections for a course including
                   8361: sections with students and sections containing other roles.
1.419     raeburn  8362: Incoming parameters: 
                   8363: 
                   8364: 1. domain
                   8365: 2. course number 
                   8366: 3. reference to array containing roles for which sections should 
                   8367: be gathered (optional).
                   8368: 4. reference to array containing status types for which sections 
                   8369: should be gathered (optional).
                   8370: 
                   8371: If the third argument is undefined, sections are gathered for any role. 
                   8372: If the fourth argument is undefined, sections are gathered for any status.
                   8373: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8374:  
1.374     raeburn  8375: Returns section hash (keys are section IDs, values are
                   8376: number of users in each section), subject to the
1.419     raeburn  8377: optional roles filter, optional status filter 
1.233     raeburn  8378: 
                   8379: =cut
                   8380: 
                   8381: ###############################################
                   8382: sub get_sections {
1.419     raeburn  8383:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8384:     if (!defined($cdom) || !defined($cnum)) {
                   8385:         my $cid =  $env{'request.course.id'};
                   8386: 
                   8387: 	return if (!defined($cid));
                   8388: 
                   8389:         $cdom = $env{'course.'.$cid.'.domain'};
                   8390:         $cnum = $env{'course.'.$cid.'.num'};
                   8391:     }
                   8392: 
                   8393:     my %sectioncount;
1.419     raeburn  8394:     my $now = time;
1.240     albertel 8395: 
1.1075.2.33  raeburn  8396:     my $check_students = 1;
                   8397:     my $only_students = 0;
                   8398:     if (ref($possible_roles) eq 'ARRAY') {
                   8399:         if (grep(/^st$/,@{$possible_roles})) {
                   8400:             if (@{$possible_roles} == 1) {
                   8401:                 $only_students = 1;
                   8402:             }
                   8403:         } else {
                   8404:             $check_students = 0;
                   8405:         }
                   8406:     }
                   8407: 
                   8408:     if ($check_students) {
1.276     albertel 8409: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8410: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8411: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8412:         my $start_index = &Apache::loncoursedata::CL_START();
                   8413:         my $end_index = &Apache::loncoursedata::CL_END();
                   8414:         my $status;
1.366     albertel 8415: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8416: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8417: 				                     $data->[$status_index],
                   8418:                                                      $data->[$start_index],
                   8419:                                                      $data->[$end_index]);
                   8420:             if ($stu_status eq 'Active') {
                   8421:                 $status = 'active';
                   8422:             } elsif ($end < $now) {
                   8423:                 $status = 'previous';
                   8424:             } elsif ($start > $now) {
                   8425:                 $status = 'future';
                   8426:             } 
                   8427: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8428:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8429:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8430: 		    $sectioncount{$section}++;
                   8431:                 }
1.240     albertel 8432: 	    }
                   8433: 	}
                   8434:     }
1.1075.2.33  raeburn  8435:     if ($only_students) {
                   8436:         return %sectioncount;
                   8437:     }
1.240     albertel 8438:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8439:     foreach my $user (sort(keys(%courseroles))) {
                   8440: 	if ($user !~ /^(\w{2})/) { next; }
                   8441: 	my ($role) = ($user =~ /^(\w{2})/);
                   8442: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8443: 	my ($section,$status);
1.240     albertel 8444: 	if ($role eq 'cr' &&
                   8445: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8446: 	    $section=$1;
                   8447: 	}
                   8448: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8449: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8450:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8451:         if ($end == -1 && $start == -1) {
                   8452:             next; #deleted role
                   8453:         }
                   8454:         if (!defined($possible_status)) { 
                   8455:             $sectioncount{$section}++;
                   8456:         } else {
                   8457:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8458:                 $status = 'active';
                   8459:             } elsif ($end < $now) {
                   8460:                 $status = 'future';
                   8461:             } elsif ($start > $now) {
                   8462:                 $status = 'previous';
                   8463:             }
                   8464:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8465:                 $sectioncount{$section}++;
                   8466:             }
                   8467:         }
1.233     raeburn  8468:     }
1.366     albertel 8469:     return %sectioncount;
1.233     raeburn  8470: }
                   8471: 
1.274     raeburn  8472: ###############################################
1.294     raeburn  8473: 
                   8474: =pod
1.405     albertel 8475: 
                   8476: =item * &get_course_users()
                   8477: 
1.275     raeburn  8478: Retrieves usernames:domains for users in the specified course
                   8479: with specific role(s), and access status. 
                   8480: 
                   8481: Incoming parameters:
1.277     albertel 8482: 1. course domain
                   8483: 2. course number
                   8484: 3. access status: users must have - either active, 
1.275     raeburn  8485: previous, future, or all.
1.277     albertel 8486: 4. reference to array of permissible roles
1.288     raeburn  8487: 5. reference to array of section restrictions (optional)
                   8488: 6. reference to results object (hash of hashes).
                   8489: 7. reference to optional userdata hash
1.609     raeburn  8490: 8. reference to optional statushash
1.630     raeburn  8491: 9. flag if privileged users (except those set to unhide in
                   8492:    course settings) should be excluded    
1.609     raeburn  8493: Keys of top level results hash are roles.
1.275     raeburn  8494: Keys of inner hashes are username:domain, with 
                   8495: values set to access type.
1.288     raeburn  8496: Optional userdata hash returns an array with arguments in the 
                   8497: same order as loncoursedata::get_classlist() for student data.
                   8498: 
1.609     raeburn  8499: Optional statushash returns
                   8500: 
1.288     raeburn  8501: Entries for end, start, section and status are blank because
                   8502: of the possibility of multiple values for non-student roles.
                   8503: 
1.275     raeburn  8504: =cut
1.405     albertel 8505: 
1.275     raeburn  8506: ###############################################
1.405     albertel 8507: 
1.275     raeburn  8508: sub get_course_users {
1.630     raeburn  8509:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8510:     my %idx = ();
1.419     raeburn  8511:     my %seclists;
1.288     raeburn  8512: 
                   8513:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8514:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8515:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8516:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8517:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8518:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8519:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8520:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8521: 
1.290     albertel 8522:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8523:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8524:         my $now = time;
1.277     albertel 8525:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8526:             my $match = 0;
1.412     raeburn  8527:             my $secmatch = 0;
1.419     raeburn  8528:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8529:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8530:             if ($section eq '') {
                   8531:                 $section = 'none';
                   8532:             }
1.291     albertel 8533:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8534:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8535:                     $secmatch = 1;
                   8536:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8537:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8538:                         $secmatch = 1;
                   8539:                     }
                   8540:                 } else {  
1.419     raeburn  8541: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8542: 		        $secmatch = 1;
                   8543:                     }
1.290     albertel 8544: 		}
1.412     raeburn  8545:                 if (!$secmatch) {
                   8546:                     next;
                   8547:                 }
1.419     raeburn  8548:             }
1.275     raeburn  8549:             if (defined($$types{'active'})) {
1.288     raeburn  8550:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8551:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8552:                     $match = 1;
1.275     raeburn  8553:                 }
                   8554:             }
                   8555:             if (defined($$types{'previous'})) {
1.609     raeburn  8556:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8557:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8558:                     $match = 1;
1.275     raeburn  8559:                 }
                   8560:             }
                   8561:             if (defined($$types{'future'})) {
1.609     raeburn  8562:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8563:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8564:                     $match = 1;
1.275     raeburn  8565:                 }
                   8566:             }
1.609     raeburn  8567:             if ($match) {
                   8568:                 push(@{$seclists{$student}},$section);
                   8569:                 if (ref($userdata) eq 'HASH') {
                   8570:                     $$userdata{$student} = $$classlist{$student};
                   8571:                 }
                   8572:                 if (ref($statushash) eq 'HASH') {
                   8573:                     $statushash->{$student}{'st'}{$section} = $status;
                   8574:                 }
1.288     raeburn  8575:             }
1.275     raeburn  8576:         }
                   8577:     }
1.412     raeburn  8578:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8579:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8580:         my $now = time;
1.609     raeburn  8581:         my %displaystatus = ( previous => 'Expired',
                   8582:                               active   => 'Active',
                   8583:                               future   => 'Future',
                   8584:                             );
1.1075.2.36  raeburn  8585:         my (%nothide,@possdoms);
1.630     raeburn  8586:         if ($hidepriv) {
                   8587:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8588:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8589:                 if ($user !~ /:/) {
                   8590:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8591:                 } else {
                   8592:                     $nothide{$user} = 1;
                   8593:                 }
                   8594:             }
1.1075.2.36  raeburn  8595:             my @possdoms = ($cdom);
                   8596:             if ($coursehash{'checkforpriv'}) {
                   8597:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   8598:             }
1.630     raeburn  8599:         }
1.439     raeburn  8600:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8601:             my $match = 0;
1.412     raeburn  8602:             my $secmatch = 0;
1.439     raeburn  8603:             my $status;
1.412     raeburn  8604:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8605:             $user =~ s/:$//;
1.439     raeburn  8606:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8607:             if ($end == -1 || $start == -1) {
                   8608:                 next;
                   8609:             }
                   8610:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8611:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8612:                 my ($uname,$udom) = split(/:/,$user);
                   8613:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8614:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8615:                         $secmatch = 1;
                   8616:                     } elsif ($usec eq '') {
1.420     albertel 8617:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8618:                             $secmatch = 1;
                   8619:                         }
                   8620:                     } else {
                   8621:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8622:                             $secmatch = 1;
                   8623:                         }
                   8624:                     }
                   8625:                     if (!$secmatch) {
                   8626:                         next;
                   8627:                     }
1.288     raeburn  8628:                 }
1.419     raeburn  8629:                 if ($usec eq '') {
                   8630:                     $usec = 'none';
                   8631:                 }
1.275     raeburn  8632:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8633:                     if ($hidepriv) {
1.1075.2.36  raeburn  8634:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  8635:                             (!$nothide{$uname.':'.$udom})) {
                   8636:                             next;
                   8637:                         }
                   8638:                     }
1.503     raeburn  8639:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8640:                         $status = 'previous';
                   8641:                     } elsif ($start > $now) {
                   8642:                         $status = 'future';
                   8643:                     } else {
                   8644:                         $status = 'active';
                   8645:                     }
1.277     albertel 8646:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8647:                         if ($status eq $type) {
1.420     albertel 8648:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8649:                                 push(@{$$users{$role}{$user}},$type);
                   8650:                             }
1.288     raeburn  8651:                             $match = 1;
                   8652:                         }
                   8653:                     }
1.419     raeburn  8654:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8655:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8656: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8657:                         }
1.420     albertel 8658:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8659:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8660:                         }
1.609     raeburn  8661:                         if (ref($statushash) eq 'HASH') {
                   8662:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8663:                         }
1.275     raeburn  8664:                     }
                   8665:                 }
                   8666:             }
                   8667:         }
1.290     albertel 8668:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8669:             if ((defined($cdom)) && (defined($cnum))) {
                   8670:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8671:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8672:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8673:                     next if ($owner eq '');
                   8674:                     my ($ownername,$ownerdom);
                   8675:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8676:                         $ownername = $1;
                   8677:                         $ownerdom = $2;
                   8678:                     } else {
                   8679:                         $ownername = $owner;
                   8680:                         $ownerdom = $cdom;
                   8681:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8682:                     }
                   8683:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8684:                     if (defined($userdata) && 
1.609     raeburn  8685: 			!exists($$userdata{$owner})) {
                   8686: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8687:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8688:                             push(@{$seclists{$owner}},'none');
                   8689:                         }
                   8690:                         if (ref($statushash) eq 'HASH') {
                   8691:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8692:                         }
1.290     albertel 8693: 		    }
1.279     raeburn  8694:                 }
                   8695:             }
                   8696:         }
1.419     raeburn  8697:         foreach my $user (keys(%seclists)) {
                   8698:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8699:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8700:         }
1.275     raeburn  8701:     }
                   8702:     return;
                   8703: }
                   8704: 
1.288     raeburn  8705: sub get_user_info {
                   8706:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8707:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8708: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8709:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8710:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8711:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8712:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8713:     return;
                   8714: }
1.275     raeburn  8715: 
1.472     raeburn  8716: ###############################################
                   8717: 
                   8718: =pod
                   8719: 
                   8720: =item * &get_user_quota()
                   8721: 
1.1075.2.41  raeburn  8722: Retrieves quota assigned for storage of user files.
                   8723: Default is to report quota for portfolio files.
1.472     raeburn  8724: 
                   8725: Incoming parameters:
                   8726: 1. user's username
                   8727: 2. user's domain
1.1075.2.41  raeburn  8728: 3. quota name - portfolio, author, or course
                   8729:    (if no quota name provided, defaults to portfolio).
1.1075.2.59  raeburn  8730: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42  raeburn  8731:    course
1.472     raeburn  8732: 
                   8733: Returns:
1.1075.2.58  raeburn  8734: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  8735: 2. (Optional) Type of setting: custom or default
                   8736:    (individually assigned or default for user's 
                   8737:    institutional status).
                   8738: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8739:    or student - types as defined in localenroll::inst_usertypes 
                   8740:    for user's domain, which determines default quota for user.
                   8741: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8742: 
                   8743: If a value has been stored in the user's environment, 
1.536     raeburn  8744: it will return that, otherwise it returns the maximal default
1.1075.2.41  raeburn  8745: defined for the user's institutional status(es) in the domain.
1.472     raeburn  8746: 
                   8747: =cut
                   8748: 
                   8749: ###############################################
                   8750: 
                   8751: 
                   8752: sub get_user_quota {
1.1075.2.42  raeburn  8753:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  8754:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8755:     if (!defined($udom)) {
                   8756:         $udom = $env{'user.domain'};
                   8757:     }
                   8758:     if (!defined($uname)) {
                   8759:         $uname = $env{'user.name'};
                   8760:     }
                   8761:     if (($udom eq '' || $uname eq '') ||
                   8762:         ($udom eq 'public') && ($uname eq 'public')) {
                   8763:         $quota = 0;
1.536     raeburn  8764:         $quotatype = 'default';
                   8765:         $defquota = 0; 
1.472     raeburn  8766:     } else {
1.536     raeburn  8767:         my $inststatus;
1.1075.2.41  raeburn  8768:         if ($quotaname eq 'course') {
                   8769:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   8770:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   8771:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   8772:             } else {
                   8773:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   8774:                 $quota = $cenv{'internal.uploadquota'};
                   8775:             }
1.536     raeburn  8776:         } else {
1.1075.2.41  raeburn  8777:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8778:                 if ($quotaname eq 'author') {
                   8779:                     $quota = $env{'environment.authorquota'};
                   8780:                 } else {
                   8781:                     $quota = $env{'environment.portfolioquota'};
                   8782:                 }
                   8783:                 $inststatus = $env{'environment.inststatus'};
                   8784:             } else {
                   8785:                 my %userenv = 
                   8786:                     &Apache::lonnet::get('environment',['portfolioquota',
                   8787:                                          'authorquota','inststatus'],$udom,$uname);
                   8788:                 my ($tmp) = keys(%userenv);
                   8789:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8790:                     if ($quotaname eq 'author') {
                   8791:                         $quota = $userenv{'authorquota'};
                   8792:                     } else {
                   8793:                         $quota = $userenv{'portfolioquota'};
                   8794:                     }
                   8795:                     $inststatus = $userenv{'inststatus'};
                   8796:                 } else {
                   8797:                     undef(%userenv);
                   8798:                 }
                   8799:             }
                   8800:         }
                   8801:         if ($quota eq '' || wantarray) {
                   8802:             if ($quotaname eq 'course') {
                   8803:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59  raeburn  8804:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
                   8805:                     ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42  raeburn  8806:                     $defquota = $domdefs{$crstype.'quota'};
                   8807:                 }
                   8808:                 if ($defquota eq '') {
                   8809:                     $defquota = 500;
                   8810:                 }
1.1075.2.41  raeburn  8811:             } else {
                   8812:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   8813:             }
                   8814:             if ($quota eq '') {
                   8815:                 $quota = $defquota;
                   8816:                 $quotatype = 'default';
                   8817:             } else {
                   8818:                 $quotatype = 'custom';
                   8819:             }
1.472     raeburn  8820:         }
                   8821:     }
1.536     raeburn  8822:     if (wantarray) {
                   8823:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8824:     } else {
                   8825:         return $quota;
                   8826:     }
1.472     raeburn  8827: }
                   8828: 
                   8829: ###############################################
                   8830: 
                   8831: =pod
                   8832: 
                   8833: =item * &default_quota()
                   8834: 
1.536     raeburn  8835: Retrieves default quota assigned for storage of user portfolio files,
                   8836: given an (optional) user's institutional status.
1.472     raeburn  8837: 
                   8838: Incoming parameters:
1.1075.2.42  raeburn  8839: 
1.472     raeburn  8840: 1. domain
1.536     raeburn  8841: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8842:    status types (e.g., faculty, staff, student etc.)
                   8843:    which apply to the user for whom the default is being retrieved.
                   8844:    If the institutional status string in undefined, the domain
1.1075.2.41  raeburn  8845:    default quota will be returned.
                   8846: 3.  quota name - portfolio, author, or course
                   8847:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  8848: 
                   8849: Returns:
1.1075.2.42  raeburn  8850: 
1.1075.2.58  raeburn  8851: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  8852: 2. (Optional) institutional type which determined the value of the
                   8853:    default quota.
1.472     raeburn  8854: 
                   8855: If a value has been stored in the domain's configuration db,
                   8856: it will return that, otherwise it returns 20 (for backwards 
                   8857: compatibility with domains which have not set up a configuration
1.1075.2.58  raeburn  8858: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  8859: 
1.536     raeburn  8860: If the user's status includes multiple types (e.g., staff and student),
                   8861: the largest default quota which applies to the user determines the
                   8862: default quota returned.
                   8863: 
1.472     raeburn  8864: =cut
                   8865: 
                   8866: ###############################################
                   8867: 
                   8868: 
                   8869: sub default_quota {
1.1075.2.41  raeburn  8870:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  8871:     my ($defquota,$settingstatus);
                   8872:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8873:                                             ['quotas'],$udom);
1.1075.2.41  raeburn  8874:     my $key = 'defaultquota';
                   8875:     if ($quotaname eq 'author') {
                   8876:         $key = 'authorquota';
                   8877:     }
1.622     raeburn  8878:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8879:         if ($inststatus ne '') {
1.765     raeburn  8880:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8881:             foreach my $item (@statuses) {
1.1075.2.41  raeburn  8882:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8883:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  8884:                         if ($defquota eq '') {
1.1075.2.41  raeburn  8885:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8886:                             $settingstatus = $item;
1.1075.2.41  raeburn  8887:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   8888:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8889:                             $settingstatus = $item;
                   8890:                         }
                   8891:                     }
1.1075.2.41  raeburn  8892:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  8893:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8894:                         if ($defquota eq '') {
                   8895:                             $defquota = $quotahash{'quotas'}{$item};
                   8896:                             $settingstatus = $item;
                   8897:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8898:                             $defquota = $quotahash{'quotas'}{$item};
                   8899:                             $settingstatus = $item;
                   8900:                         }
1.536     raeburn  8901:                     }
                   8902:                 }
                   8903:             }
                   8904:         }
                   8905:         if ($defquota eq '') {
1.1075.2.41  raeburn  8906:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8907:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   8908:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  8909:                 $defquota = $quotahash{'quotas'}{'default'};
                   8910:             }
1.536     raeburn  8911:             $settingstatus = 'default';
1.1075.2.42  raeburn  8912:             if ($defquota eq '') {
                   8913:                 if ($quotaname eq 'author') {
                   8914:                     $defquota = 500;
                   8915:                 }
                   8916:             }
1.536     raeburn  8917:         }
                   8918:     } else {
                   8919:         $settingstatus = 'default';
1.1075.2.41  raeburn  8920:         if ($quotaname eq 'author') {
                   8921:             $defquota = 500;
                   8922:         } else {
                   8923:             $defquota = 20;
                   8924:         }
1.536     raeburn  8925:     }
                   8926:     if (wantarray) {
                   8927:         return ($defquota,$settingstatus);
1.472     raeburn  8928:     } else {
1.536     raeburn  8929:         return $defquota;
1.472     raeburn  8930:     }
                   8931: }
                   8932: 
1.1075.2.41  raeburn  8933: ###############################################
                   8934: 
                   8935: =pod
                   8936: 
1.1075.2.42  raeburn  8937: =item * &excess_filesize_warning()
1.1075.2.41  raeburn  8938: 
                   8939: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42  raeburn  8940: of existing file within authoring space will cause quota for the authoring
                   8941: space to be exceeded.
                   8942: 
                   8943: Same, if upload of a file directly to a course/community via Course Editor
                   8944: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41  raeburn  8945: 
1.1075.2.61  raeburn  8946: Inputs: 7 
1.1075.2.42  raeburn  8947: 1. username or coursenum
1.1075.2.41  raeburn  8948: 2. domain
1.1075.2.42  raeburn  8949: 3. context ('author' or 'course')
1.1075.2.41  raeburn  8950: 4. filename of file for which action is being requested
                   8951: 5. filesize (kB) of file
                   8952: 6. action being taken: copy or upload.
1.1075.2.59  raeburn  8953: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41  raeburn  8954: 
                   8955: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
                   8956:          otherwise return null.
                   8957: 
1.1075.2.42  raeburn  8958: =back
                   8959: 
1.1075.2.41  raeburn  8960: =cut
                   8961: 
1.1075.2.42  raeburn  8962: sub excess_filesize_warning {
1.1075.2.59  raeburn  8963:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42  raeburn  8964:     my $current_disk_usage = 0;
1.1075.2.59  raeburn  8965:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42  raeburn  8966:     if ($context eq 'author') {
                   8967:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   8968:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   8969:     } else {
                   8970:         foreach my $subdir ('docs','supplemental') {
                   8971:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   8972:         }
                   8973:     }
1.1075.2.41  raeburn  8974:     $disk_quota = int($disk_quota * 1000);
                   8975:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69  raeburn  8976:         return '<p class="LC_warning">'.
1.1075.2.41  raeburn  8977:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69  raeburn  8978:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   8979:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41  raeburn  8980:                             $disk_quota,$current_disk_usage).
                   8981:                '</p>';
                   8982:     }
                   8983:     return;
                   8984: }
                   8985: 
                   8986: ###############################################
                   8987: 
                   8988: 
1.384     raeburn  8989: sub get_secgrprole_info {
                   8990:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   8991:     my %sections_count = &get_sections($cdom,$cnum);
                   8992:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   8993:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   8994:     my @groups = sort(keys(%curr_groups));
                   8995:     my $allroles = [];
                   8996:     my $rolehash;
                   8997:     my $accesshash = {
                   8998:                      active => 'Currently has access',
                   8999:                      future => 'Will have future access',
                   9000:                      previous => 'Previously had access',
                   9001:                   };
                   9002:     if ($needroles) {
                   9003:         $rolehash = {'all' => 'all'};
1.385     albertel 9004:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9005: 	if (&Apache::lonnet::error(%user_roles)) {
                   9006: 	    undef(%user_roles);
                   9007: 	}
                   9008:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9009:             my ($role)=split(/\:/,$item,2);
                   9010:             if ($role eq 'cr') { next; }
                   9011:             if ($role =~ /^cr/) {
                   9012:                 $$rolehash{$role} = (split('/',$role))[3];
                   9013:             } else {
                   9014:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9015:             }
                   9016:         }
                   9017:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9018:             push(@{$allroles},$key);
                   9019:         }
                   9020:         push (@{$allroles},'st');
                   9021:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9022:     }
                   9023:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9024: }
                   9025: 
1.555     raeburn  9026: sub user_picker {
1.994     raeburn  9027:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  9028:     my $currdom = $dom;
                   9029:     my %curr_selected = (
                   9030:                         srchin => 'dom',
1.580     raeburn  9031:                         srchby => 'lastname',
1.555     raeburn  9032:                       );
                   9033:     my $srchterm;
1.625     raeburn  9034:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9035:         if ($srch->{'srchby'} ne '') {
                   9036:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9037:         }
                   9038:         if ($srch->{'srchin'} ne '') {
                   9039:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9040:         }
                   9041:         if ($srch->{'srchtype'} ne '') {
                   9042:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9043:         }
                   9044:         if ($srch->{'srchdomain'} ne '') {
                   9045:             $currdom = $srch->{'srchdomain'};
                   9046:         }
                   9047:         $srchterm = $srch->{'srchterm'};
                   9048:     }
                   9049:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  9050:                     'usr'       => 'Search criteria',
1.563     raeburn  9051:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9052:                     'uname'     => 'username',
                   9053:                     'lastname'  => 'last name',
1.555     raeburn  9054:                     'lastfirst' => 'last name, first name',
1.558     albertel 9055:                     'crs'       => 'in this course',
1.576     raeburn  9056:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9057:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9058:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9059:                     'exact'     => 'is',
                   9060:                     'contains'  => 'contains',
1.569     raeburn  9061:                     'begins'    => 'begins with',
1.571     raeburn  9062:                     'youm'      => "You must include some text to search for.",
                   9063:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9064:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9065:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9066:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9067:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9068:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9069:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9070:                                        );
1.563     raeburn  9071:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9072:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9073: 
                   9074:     my @srchins = ('crs','dom','alc','instd');
                   9075: 
                   9076:     foreach my $option (@srchins) {
                   9077:         # FIXME 'alc' option unavailable until 
                   9078:         #       loncreateuser::print_user_query_page()
                   9079:         #       has been completed.
                   9080:         next if ($option eq 'alc');
1.880     raeburn  9081:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9082:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9083:         if ($curr_selected{'srchin'} eq $option) {
                   9084:             $srchinsel .= ' 
                   9085:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9086:         } else {
                   9087:             $srchinsel .= '
                   9088:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9089:         }
1.555     raeburn  9090:     }
1.563     raeburn  9091:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9092: 
                   9093:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9094:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9095:         if ($curr_selected{'srchby'} eq $option) {
                   9096:             $srchbysel .= '
                   9097:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9098:         } else {
                   9099:             $srchbysel .= '
                   9100:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9101:          }
                   9102:     }
                   9103:     $srchbysel .= "\n  </select>\n";
                   9104: 
                   9105:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9106:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9107:         if ($curr_selected{'srchtype'} eq $option) {
                   9108:             $srchtypesel .= '
                   9109:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9110:         } else {
                   9111:             $srchtypesel .= '
                   9112:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9113:         }
                   9114:     }
                   9115:     $srchtypesel .= "\n  </select>\n";
                   9116: 
1.558     albertel 9117:     my ($newuserscript,$new_user_create);
1.994     raeburn  9118:     my $context_dom = $env{'request.role.domain'};
                   9119:     if ($context eq 'requestcrs') {
                   9120:         if ($env{'form.coursedom'} ne '') { 
                   9121:             $context_dom = $env{'form.coursedom'};
                   9122:         }
                   9123:     }
1.556     raeburn  9124:     if ($forcenewuser) {
1.576     raeburn  9125:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9126:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9127:                 if ($cancreate) {
                   9128:                     $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>';
                   9129:                 } else {
1.799     bisitz   9130:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9131:                     my %usertypetext = (
                   9132:                         official   => 'institutional',
                   9133:                         unofficial => 'non-institutional',
                   9134:                     );
1.799     bisitz   9135:                     $new_user_create = '<p class="LC_warning">'
                   9136:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9137:                                       .' '
                   9138:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9139:                                           ,'<a href="'.$helplink.'">','</a>')
                   9140:                                       .'</p><br />';
1.627     raeburn  9141:                 }
1.576     raeburn  9142:             }
                   9143:         }
                   9144: 
1.556     raeburn  9145:         $newuserscript = <<"ENDSCRIPT";
                   9146: 
1.570     raeburn  9147: function setSearch(createnew,callingForm) {
1.556     raeburn  9148:     if (createnew == 1) {
1.570     raeburn  9149:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9150:             if (callingForm.srchby.options[i].value == 'uname') {
                   9151:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9152:             }
                   9153:         }
1.570     raeburn  9154:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9155:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9156: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9157:             }
                   9158:         }
1.570     raeburn  9159:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9160:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9161:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9162:             }
                   9163:         }
1.570     raeburn  9164:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9165:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9166:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9167:             }
                   9168:         }
                   9169:     }
                   9170: }
                   9171: ENDSCRIPT
1.558     albertel 9172: 
1.556     raeburn  9173:     }
                   9174: 
1.555     raeburn  9175:     my $output = <<"END_BLOCK";
1.556     raeburn  9176: <script type="text/javascript">
1.824     bisitz   9177: // <![CDATA[
1.570     raeburn  9178: function validateEntry(callingForm) {
1.558     albertel 9179: 
1.556     raeburn  9180:     var checkok = 1;
1.558     albertel 9181:     var srchin;
1.570     raeburn  9182:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9183: 	if ( callingForm.srchin[i].checked ) {
                   9184: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9185: 	}
                   9186:     }
                   9187: 
1.570     raeburn  9188:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9189:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9190:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9191:     var srchterm =  callingForm.srchterm.value;
                   9192:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9193:     var msg = "";
                   9194: 
                   9195:     if (srchterm == "") {
                   9196:         checkok = 0;
1.571     raeburn  9197:         msg += "$lt{'youm'}\\n";
1.556     raeburn  9198:     }
                   9199: 
1.569     raeburn  9200:     if (srchtype== 'begins') {
                   9201:         if (srchterm.length < 2) {
                   9202:             checkok = 0;
1.571     raeburn  9203:             msg += "$lt{'thte'}\\n";
1.569     raeburn  9204:         }
                   9205:     }
                   9206: 
1.556     raeburn  9207:     if (srchtype== 'contains') {
                   9208:         if (srchterm.length < 3) {
                   9209:             checkok = 0;
1.571     raeburn  9210:             msg += "$lt{'thet'}\\n";
1.556     raeburn  9211:         }
                   9212:     }
                   9213:     if (srchin == 'instd') {
                   9214:         if (srchdomain == '') {
                   9215:             checkok = 0;
1.571     raeburn  9216:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  9217:         }
                   9218:     }
                   9219:     if (srchin == 'dom') {
                   9220:         if (srchdomain == '') {
                   9221:             checkok = 0;
1.571     raeburn  9222:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  9223:         }
                   9224:     }
                   9225:     if (srchby == 'lastfirst') {
                   9226:         if (srchterm.indexOf(",") == -1) {
                   9227:             checkok = 0;
1.571     raeburn  9228:             msg += "$lt{'whus'}\\n";
1.556     raeburn  9229:         }
                   9230:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9231:             checkok = 0;
1.571     raeburn  9232:             msg += "$lt{'whse'}\\n";
1.556     raeburn  9233:         }
                   9234:     }
                   9235:     if (checkok == 0) {
1.571     raeburn  9236:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  9237:         return;
                   9238:     }
                   9239:     if (checkok == 1) {
1.570     raeburn  9240:         callingForm.submit();
1.556     raeburn  9241:     }
                   9242: }
                   9243: 
                   9244: $newuserscript
                   9245: 
1.824     bisitz   9246: // ]]>
1.556     raeburn  9247: </script>
1.558     albertel 9248: 
                   9249: $new_user_create
                   9250: 
1.555     raeburn  9251: END_BLOCK
1.558     albertel 9252: 
1.876     raeburn  9253:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   9254:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   9255:                $domform.
                   9256:                &Apache::lonhtmlcommon::row_closure().
                   9257:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   9258:                $srchbysel.
                   9259:                $srchtypesel. 
                   9260:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9261:                $srchinsel.
                   9262:                &Apache::lonhtmlcommon::row_closure(1). 
                   9263:                &Apache::lonhtmlcommon::end_pick_box().
                   9264:                '<br />';
1.555     raeburn  9265:     return $output;
                   9266: }
                   9267: 
1.612     raeburn  9268: sub user_rule_check {
1.615     raeburn  9269:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  9270:     my $response;
                   9271:     if (ref($usershash) eq 'HASH') {
                   9272:         foreach my $user (keys(%{$usershash})) {
                   9273:             my ($uname,$udom) = split(/:/,$user);
                   9274:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  9275:             my ($id,$newuser);
1.612     raeburn  9276:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  9277:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  9278:                 $id = $usershash->{$user}->{'id'};
                   9279:             }
                   9280:             my $inst_response;
                   9281:             if (ref($checks) eq 'HASH') {
                   9282:                 if (defined($checks->{'username'})) {
1.615     raeburn  9283:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  9284:                         &Apache::lonnet::get_instuser($udom,$uname);
                   9285:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  9286:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  9287:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   9288:                 }
1.615     raeburn  9289:             } else {
                   9290:                 ($inst_response,%{$inst_results->{$user}}) =
                   9291:                     &Apache::lonnet::get_instuser($udom,$uname);
                   9292:                 return;
1.612     raeburn  9293:             }
1.615     raeburn  9294:             if (!$got_rules->{$udom}) {
1.612     raeburn  9295:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9296:                                                   ['usercreation'],$udom);
                   9297:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  9298:                     foreach my $item ('username','id') {
1.612     raeburn  9299:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9300:                             $$curr_rules{$udom}{$item} = 
                   9301:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  9302:                         }
                   9303:                     }
                   9304:                 }
1.615     raeburn  9305:                 $got_rules->{$udom} = 1;  
1.585     raeburn  9306:             }
1.612     raeburn  9307:             foreach my $item (keys(%{$checks})) {
                   9308:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9309:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9310:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   9311:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   9312:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9313:                                 if ($rule_check{$rule}) {
                   9314:                                     $$rulematch{$user}{$item} = $rule;
                   9315:                                     if ($inst_response eq 'ok') {
1.615     raeburn  9316:                                         if (ref($inst_results) eq 'HASH') {
                   9317:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9318:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9319:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   9320:                                                 }
1.612     raeburn  9321:                                             }
                   9322:                                         }
1.615     raeburn  9323:                                     }
                   9324:                                     last;
1.585     raeburn  9325:                                 }
                   9326:                             }
                   9327:                         }
                   9328:                     }
                   9329:                 }
                   9330:             }
                   9331:         }
                   9332:     }
1.612     raeburn  9333:     return;
                   9334: }
                   9335: 
                   9336: sub user_rule_formats {
                   9337:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9338:     my %text = ( 
                   9339:                  'username' => 'Usernames',
                   9340:                  'id'       => 'IDs',
                   9341:                );
                   9342:     my $output;
                   9343:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9344:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9345:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  9346:             $output = '<br />'.
                   9347:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9348:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9349:                       ' <ul>';
1.612     raeburn  9350:             foreach my $rule (@{$ruleorder}) {
                   9351:                 if (ref($curr_rules) eq 'ARRAY') {
                   9352:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9353:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9354:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9355:                                         $rules->{$rule}{'desc'}.'</li>';
                   9356:                         }
                   9357:                     }
                   9358:                 }
                   9359:             }
                   9360:             $output .= '</ul>';
                   9361:         }
                   9362:     }
                   9363:     return $output;
                   9364: }
                   9365: 
                   9366: sub instrule_disallow_msg {
1.615     raeburn  9367:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9368:     my $response;
                   9369:     my %text = (
                   9370:                   item   => 'username',
                   9371:                   items  => 'usernames',
                   9372:                   match  => 'matches',
                   9373:                   do     => 'does',
                   9374:                   action => 'a username',
                   9375:                   one    => 'one',
                   9376:                );
                   9377:     if ($count > 1) {
                   9378:         $text{'item'} = 'usernames';
                   9379:         $text{'match'} ='match';
                   9380:         $text{'do'} = 'do';
                   9381:         $text{'action'} = 'usernames',
                   9382:         $text{'one'} = 'ones';
                   9383:     }
                   9384:     if ($checkitem eq 'id') {
                   9385:         $text{'items'} = 'IDs';
                   9386:         $text{'item'} = 'ID';
                   9387:         $text{'action'} = 'an ID';
1.615     raeburn  9388:         if ($count > 1) {
                   9389:             $text{'item'} = 'IDs';
                   9390:             $text{'action'} = 'IDs';
                   9391:         }
1.612     raeburn  9392:     }
1.674     bisitz   9393:     $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  9394:     if ($mode eq 'upload') {
                   9395:         if ($checkitem eq 'username') {
                   9396:             $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'}.");
                   9397:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9398:             $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  9399:         }
1.669     raeburn  9400:     } elsif ($mode eq 'selfcreate') {
                   9401:         if ($checkitem eq 'id') {
                   9402:             $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.");
                   9403:         }
1.615     raeburn  9404:     } else {
                   9405:         if ($checkitem eq 'username') {
                   9406:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9407:         } elsif ($checkitem eq 'id') {
                   9408:             $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.");
                   9409:         }
1.612     raeburn  9410:     }
                   9411:     return $response;
1.585     raeburn  9412: }
                   9413: 
1.624     raeburn  9414: sub personal_data_fieldtitles {
                   9415:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9416:                         id => 'Student/Employee ID',
                   9417:                         permanentemail => 'E-mail address',
                   9418:                         lastname => 'Last Name',
                   9419:                         firstname => 'First Name',
                   9420:                         middlename => 'Middle Name',
                   9421:                         generation => 'Generation',
                   9422:                         gen => 'Generation',
1.765     raeburn  9423:                         inststatus => 'Affiliation',
1.624     raeburn  9424:                    );
                   9425:     return %fieldtitles;
                   9426: }
                   9427: 
1.642     raeburn  9428: sub sorted_inst_types {
                   9429:     my ($dom) = @_;
1.1075.2.70  raeburn  9430:     my ($usertypes,$order);
                   9431:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   9432:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   9433:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   9434:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   9435:     } else {
                   9436:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9437:     }
1.642     raeburn  9438:     my $othertitle = &mt('All users');
                   9439:     if ($env{'request.course.id'}) {
1.668     raeburn  9440:         $othertitle  = &mt('Any users');
1.642     raeburn  9441:     }
                   9442:     my @types;
                   9443:     if (ref($order) eq 'ARRAY') {
                   9444:         @types = @{$order};
                   9445:     }
                   9446:     if (@types == 0) {
                   9447:         if (ref($usertypes) eq 'HASH') {
                   9448:             @types = sort(keys(%{$usertypes}));
                   9449:         }
                   9450:     }
                   9451:     if (keys(%{$usertypes}) > 0) {
                   9452:         $othertitle = &mt('Other users');
                   9453:     }
                   9454:     return ($othertitle,$usertypes,\@types);
                   9455: }
                   9456: 
1.645     raeburn  9457: sub get_institutional_codes {
                   9458:     my ($settings,$allcourses,$LC_code) = @_;
                   9459: # Get complete list of course sections to update
                   9460:     my @currsections = ();
                   9461:     my @currxlists = ();
                   9462:     my $coursecode = $$settings{'internal.coursecode'};
                   9463: 
                   9464:     if ($$settings{'internal.sectionnums'} ne '') {
                   9465:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9466:     }
                   9467: 
                   9468:     if ($$settings{'internal.crosslistings'} ne '') {
                   9469:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9470:     }
                   9471: 
                   9472:     if (@currxlists > 0) {
                   9473:         foreach (@currxlists) {
                   9474:             if (m/^([^:]+):(\w*)$/) {
                   9475:                 unless (grep/^$1$/,@{$allcourses}) {
                   9476:                     push @{$allcourses},$1;
                   9477:                     $$LC_code{$1} = $2;
                   9478:                 }
                   9479:             }
                   9480:         }
                   9481:     }
                   9482:  
                   9483:     if (@currsections > 0) {
                   9484:         foreach (@currsections) {
                   9485:             if (m/^(\w+):(\w*)$/) {
                   9486:                 my $sec = $coursecode.$1;
                   9487:                 my $lc_sec = $2;
                   9488:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9489:                     push @{$allcourses},$sec;
                   9490:                     $$LC_code{$sec} = $lc_sec;
                   9491:                 }
                   9492:             }
                   9493:         }
                   9494:     }
                   9495:     return;
                   9496: }
                   9497: 
1.971     raeburn  9498: sub get_standard_codeitems {
                   9499:     return ('Year','Semester','Department','Number','Section');
                   9500: }
                   9501: 
1.112     bowersj2 9502: =pod
                   9503: 
1.780     raeburn  9504: =head1 Slot Helpers
                   9505: 
                   9506: =over 4
                   9507: 
                   9508: =item * sorted_slots()
                   9509: 
1.1040    raeburn  9510: Sorts an array of slot names in order of an optional sort key,
                   9511: default sort is by slot start time (earliest first). 
1.780     raeburn  9512: 
                   9513: Inputs:
                   9514: 
                   9515: =over 4
                   9516: 
                   9517: slotsarr  - Reference to array of unsorted slot names.
                   9518: 
                   9519: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9520: 
1.1040    raeburn  9521: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9522: 
1.549     albertel 9523: =back
                   9524: 
1.780     raeburn  9525: Returns:
                   9526: 
                   9527: =over 4
                   9528: 
1.1040    raeburn  9529: sorted   - An array of slot names sorted by a specified sort key 
                   9530:            (default sort key is start time of the slot).
1.780     raeburn  9531: 
                   9532: =back
                   9533: 
                   9534: =cut
                   9535: 
                   9536: 
                   9537: sub sorted_slots {
1.1040    raeburn  9538:     my ($slotsarr,$slots,$sortkey) = @_;
                   9539:     if ($sortkey eq '') {
                   9540:         $sortkey = 'starttime';
                   9541:     }
1.780     raeburn  9542:     my @sorted;
                   9543:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9544:         @sorted =
                   9545:             sort {
                   9546:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9547:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9548:                      }
                   9549:                      if (ref($slots->{$a})) { return -1;}
                   9550:                      if (ref($slots->{$b})) { return 1;}
                   9551:                      return 0;
                   9552:                  } @{$slotsarr};
                   9553:     }
                   9554:     return @sorted;
                   9555: }
                   9556: 
1.1040    raeburn  9557: =pod
                   9558: 
                   9559: =item * get_future_slots()
                   9560: 
                   9561: Inputs:
                   9562: 
                   9563: =over 4
                   9564: 
                   9565: cnum - course number
                   9566: 
                   9567: cdom - course domain
                   9568: 
                   9569: now - current UNIX time
                   9570: 
                   9571: symb - optional symb
                   9572: 
                   9573: =back
                   9574: 
                   9575: Returns:
                   9576: 
                   9577: =over 4
                   9578: 
                   9579: sorted_reservable - ref to array of student_schedulable slots currently 
                   9580:                     reservable, ordered by end date of reservation period.
                   9581: 
                   9582: reservable_now - ref to hash of student_schedulable slots currently
                   9583:                  reservable.
                   9584: 
                   9585:     Keys in inner hash are:
                   9586:     (a) symb: either blank or symb to which slot use is restricted.
                   9587:     (b) endreserve: end date of reservation period. 
                   9588: 
                   9589: sorted_future - ref to array of student_schedulable slots reservable in
                   9590:                 the future, ordered by start date of reservation period.
                   9591: 
                   9592: future_reservable - ref to hash of student_schedulable slots reservable
                   9593:                     in the future.
                   9594: 
                   9595:     Keys in inner hash are:
                   9596:     (a) symb: either blank or symb to which slot use is restricted.
                   9597:     (b) startreserve:  start date of reservation period.
                   9598: 
                   9599: =back
                   9600: 
                   9601: =cut
                   9602: 
                   9603: sub get_future_slots {
                   9604:     my ($cnum,$cdom,$now,$symb) = @_;
                   9605:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9606:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9607:     foreach my $slot (keys(%slots)) {
                   9608:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9609:         if ($symb) {
                   9610:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9611:                      ($slots{$slot}->{'symb'} ne $symb));
                   9612:         }
                   9613:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9614:             ($slots{$slot}->{'endtime'} > $now)) {
                   9615:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9616:                 my $userallowed = 0;
                   9617:                 if ($slots{$slot}->{'allowedsections'}) {
                   9618:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9619:                     if (!defined($env{'request.role.sec'})
                   9620:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9621:                         $userallowed=1;
                   9622:                     } else {
                   9623:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9624:                             $userallowed=1;
                   9625:                         }
                   9626:                     }
                   9627:                     unless ($userallowed) {
                   9628:                         if (defined($env{'request.course.groups'})) {
                   9629:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9630:                             foreach my $group (@groups) {
                   9631:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9632:                                     $userallowed=1;
                   9633:                                     last;
                   9634:                                 }
                   9635:                             }
                   9636:                         }
                   9637:                     }
                   9638:                 }
                   9639:                 if ($slots{$slot}->{'allowedusers'}) {
                   9640:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9641:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9642:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9643:                         $userallowed = 1;
                   9644:                     }
                   9645:                 }
                   9646:                 next unless($userallowed);
                   9647:             }
                   9648:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9649:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9650:             my $symb = $slots{$slot}->{'symb'};
                   9651:             if (($startreserve < $now) &&
                   9652:                 (!$endreserve || $endreserve > $now)) {
                   9653:                 my $lastres = $endreserve;
                   9654:                 if (!$lastres) {
                   9655:                     $lastres = $slots{$slot}->{'starttime'};
                   9656:                 }
                   9657:                 $reservable_now{$slot} = {
                   9658:                                            symb       => $symb,
                   9659:                                            endreserve => $lastres
                   9660:                                          };
                   9661:             } elsif (($startreserve > $now) &&
                   9662:                      (!$endreserve || $endreserve > $startreserve)) {
                   9663:                 $future_reservable{$slot} = {
                   9664:                                               symb         => $symb,
                   9665:                                               startreserve => $startreserve
                   9666:                                             };
                   9667:             }
                   9668:         }
                   9669:     }
                   9670:     my @unsorted_reservable = keys(%reservable_now);
                   9671:     if (@unsorted_reservable > 0) {
                   9672:         @sorted_reservable = 
                   9673:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9674:     }
                   9675:     my @unsorted_future = keys(%future_reservable);
                   9676:     if (@unsorted_future > 0) {
                   9677:         @sorted_future =
                   9678:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9679:     }
                   9680:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9681: }
1.780     raeburn  9682: 
                   9683: =pod
                   9684: 
1.1057    foxr     9685: =back
                   9686: 
1.549     albertel 9687: =head1 HTTP Helpers
                   9688: 
                   9689: =over 4
                   9690: 
1.648     raeburn  9691: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9692: 
1.258     albertel 9693: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9694: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9695: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9696: 
                   9697: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9698: $possible_names is an ref to an array of form element names.  As an example:
                   9699: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9700: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9701: 
                   9702: =cut
1.1       albertel 9703: 
1.6       albertel 9704: sub get_unprocessed_cgi {
1.25      albertel 9705:   my ($query,$possible_names)= @_;
1.26      matthew  9706:   # $Apache::lonxml::debug=1;
1.356     albertel 9707:   foreach my $pair (split(/&/,$query)) {
                   9708:     my ($name, $value) = split(/=/,$pair);
1.369     www      9709:     $name = &unescape($name);
1.25      albertel 9710:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9711:       $value =~ tr/+/ /;
                   9712:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9713:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9714:     }
1.16      harris41 9715:   }
1.6       albertel 9716: }
                   9717: 
1.112     bowersj2 9718: =pod
                   9719: 
1.648     raeburn  9720: =item * &cacheheader() 
1.112     bowersj2 9721: 
                   9722: returns cache-controlling header code
                   9723: 
                   9724: =cut
                   9725: 
1.7       albertel 9726: sub cacheheader {
1.258     albertel 9727:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9728:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9729:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9730:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9731:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9732:     return $output;
1.7       albertel 9733: }
                   9734: 
1.112     bowersj2 9735: =pod
                   9736: 
1.648     raeburn  9737: =item * &no_cache($r) 
1.112     bowersj2 9738: 
                   9739: specifies header code to not have cache
                   9740: 
                   9741: =cut
                   9742: 
1.9       albertel 9743: sub no_cache {
1.216     albertel 9744:     my ($r) = @_;
                   9745:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9746: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9747:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9748:     $r->no_cache(1);
                   9749:     $r->header_out("Expires" => $date);
                   9750:     $r->header_out("Pragma" => "no-cache");
1.123     www      9751: }
                   9752: 
                   9753: sub content_type {
1.181     albertel 9754:     my ($r,$type,$charset) = @_;
1.299     foxr     9755:     if ($r) {
                   9756: 	#  Note that printout.pl calls this with undef for $r.
                   9757: 	&no_cache($r);
                   9758:     }
1.258     albertel 9759:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9760:     unless ($charset) {
                   9761: 	$charset=&Apache::lonlocal::current_encoding;
                   9762:     }
                   9763:     if ($charset) { $type.='; charset='.$charset; }
                   9764:     if ($r) {
                   9765: 	$r->content_type($type);
                   9766:     } else {
                   9767: 	print("Content-type: $type\n\n");
                   9768:     }
1.9       albertel 9769: }
1.25      albertel 9770: 
1.112     bowersj2 9771: =pod
                   9772: 
1.648     raeburn  9773: =item * &add_to_env($name,$value) 
1.112     bowersj2 9774: 
1.258     albertel 9775: adds $name to the %env hash with value
1.112     bowersj2 9776: $value, if $name already exists, the entry is converted to an array
                   9777: reference and $value is added to the array.
                   9778: 
                   9779: =cut
                   9780: 
1.25      albertel 9781: sub add_to_env {
                   9782:   my ($name,$value)=@_;
1.258     albertel 9783:   if (defined($env{$name})) {
                   9784:     if (ref($env{$name})) {
1.25      albertel 9785:       #already have multiple values
1.258     albertel 9786:       push(@{ $env{$name} },$value);
1.25      albertel 9787:     } else {
                   9788:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9789:       my $first=$env{$name};
                   9790:       undef($env{$name});
                   9791:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9792:     }
                   9793:   } else {
1.258     albertel 9794:     $env{$name}=$value;
1.25      albertel 9795:   }
1.31      albertel 9796: }
1.149     albertel 9797: 
                   9798: =pod
                   9799: 
1.648     raeburn  9800: =item * &get_env_multiple($name) 
1.149     albertel 9801: 
1.258     albertel 9802: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9803: values may be defined and end up as an array ref.
                   9804: 
                   9805: returns an array of values
                   9806: 
                   9807: =cut
                   9808: 
                   9809: sub get_env_multiple {
                   9810:     my ($name) = @_;
                   9811:     my @values;
1.258     albertel 9812:     if (defined($env{$name})) {
1.149     albertel 9813:         # exists is it an array
1.258     albertel 9814:         if (ref($env{$name})) {
                   9815:             @values=@{ $env{$name} };
1.149     albertel 9816:         } else {
1.258     albertel 9817:             $values[0]=$env{$name};
1.149     albertel 9818:         }
                   9819:     }
                   9820:     return(@values);
                   9821: }
                   9822: 
1.660     raeburn  9823: sub ask_for_embedded_content {
                   9824:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9825:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  9826:         %currsubfile,%unused,$rem);
1.1071    raeburn  9827:     my $counter = 0;
                   9828:     my $numnew = 0;
1.987     raeburn  9829:     my $numremref = 0;
                   9830:     my $numinvalid = 0;
                   9831:     my $numpathchg = 0;
                   9832:     my $numexisting = 0;
1.1071    raeburn  9833:     my $numunused = 0;
                   9834:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53  raeburn  9835:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  9836:     my $heading = &mt('Upload embedded files');
                   9837:     my $buttontext = &mt('Upload');
                   9838: 
1.1075.2.11  raeburn  9839:     if ($env{'request.course.id'}) {
1.1075.2.35  raeburn  9840:         if ($actionurl eq '/adm/dependencies') {
                   9841:             $navmap = Apache::lonnavmaps::navmap->new();
                   9842:         }
                   9843:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9844:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11  raeburn  9845:     }
1.1075.2.35  raeburn  9846:     if (($actionurl eq '/adm/portfolio') ||
                   9847:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  9848:         my $current_path='/';
                   9849:         if ($env{'form.currentpath'}) {
                   9850:             $current_path = $env{'form.currentpath'};
                   9851:         }
                   9852:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35  raeburn  9853:             $udom = $cdom;
                   9854:             $uname = $cnum;
1.984     raeburn  9855:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9856:         } else {
                   9857:             $udom = $env{'user.domain'};
                   9858:             $uname = $env{'user.name'};
                   9859:             $url = '/userfiles/portfolio';
                   9860:         }
1.987     raeburn  9861:         $toplevel = $url.'/';
1.984     raeburn  9862:         $url .= $current_path;
                   9863:         $getpropath = 1;
1.987     raeburn  9864:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9865:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9866:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9867:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9868:         $toplevel = $url;
1.984     raeburn  9869:         if ($rest ne '') {
1.987     raeburn  9870:             $url .= $rest;
                   9871:         }
                   9872:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9873:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9874:             $url = $args->{'docs_url'};
                   9875:             $toplevel = $url;
1.1075.2.11  raeburn  9876:             if ($args->{'context'} eq 'paste') {
                   9877:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9878:                 ($path) =
                   9879:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9880:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9881:                 $fileloc =~ s{^/}{};
                   9882:             }
1.1071    raeburn  9883:         }
                   9884:     } elsif ($actionurl eq '/adm/dependencies') {
                   9885:         if ($env{'request.course.id'} ne '') {
                   9886:             if (ref($args) eq 'HASH') {
                   9887:                 $url = $args->{'docs_url'};
                   9888:                 $title = $args->{'docs_title'};
1.1075.2.35  raeburn  9889:                 $toplevel = $url;
                   9890:                 unless ($toplevel =~ m{^/}) {
                   9891:                     $toplevel = "/$url";
                   9892:                 }
1.1075.2.11  raeburn  9893:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35  raeburn  9894:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   9895:                     $path = $1;
                   9896:                 } else {
                   9897:                     ($path) =
                   9898:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9899:                 }
1.1071    raeburn  9900:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9901:                 $fileloc =~ s{^/}{};
                   9902:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9903:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9904:             }
1.987     raeburn  9905:         }
1.1075.2.35  raeburn  9906:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9907:         $udom = $cdom;
                   9908:         $uname = $cnum;
                   9909:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   9910:         $toplevel = $url;
                   9911:         $path = $url;
                   9912:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   9913:         $fileloc =~ s{^/}{};
                   9914:     }
                   9915:     foreach my $file (keys(%{$allfiles})) {
                   9916:         my $embed_file;
                   9917:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   9918:             $embed_file = $1;
                   9919:         } else {
                   9920:             $embed_file = $file;
                   9921:         }
1.1075.2.55  raeburn  9922:         my ($absolutepath,$cleaned_file);
                   9923:         if ($embed_file =~ m{^\w+://}) {
                   9924:             $cleaned_file = $embed_file;
1.1075.2.47  raeburn  9925:             $newfiles{$cleaned_file} = 1;
                   9926:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9927:         } else {
1.1075.2.55  raeburn  9928:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  9929:             if ($embed_file =~ m{^/}) {
                   9930:                 $absolutepath = $embed_file;
                   9931:             }
1.1075.2.47  raeburn  9932:             if ($cleaned_file =~ m{/}) {
                   9933:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  9934:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9935:                 my $item = $fname;
                   9936:                 if ($path ne '') {
                   9937:                     $item = $path.'/'.$fname;
                   9938:                     $subdependencies{$path}{$fname} = 1;
                   9939:                 } else {
                   9940:                     $dependencies{$item} = 1;
                   9941:                 }
                   9942:                 if ($absolutepath) {
                   9943:                     $mapping{$item} = $absolutepath;
                   9944:                 } else {
                   9945:                     $mapping{$item} = $embed_file;
                   9946:                 }
                   9947:             } else {
                   9948:                 $dependencies{$embed_file} = 1;
                   9949:                 if ($absolutepath) {
1.1075.2.47  raeburn  9950:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  9951:                 } else {
1.1075.2.47  raeburn  9952:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9953:                 }
                   9954:             }
1.984     raeburn  9955:         }
                   9956:     }
1.1071    raeburn  9957:     my $dirptr = 16384;
1.984     raeburn  9958:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9959:         $currsubfile{$path} = {};
1.1075.2.35  raeburn  9960:         if (($actionurl eq '/adm/portfolio') ||
                   9961:             ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  9962:             my ($sublistref,$listerror) =
                   9963:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9964:             if (ref($sublistref) eq 'ARRAY') {
                   9965:                 foreach my $line (@{$sublistref}) {
                   9966:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9967:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9968:                 }
1.984     raeburn  9969:             }
1.987     raeburn  9970:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9971:             if (opendir(my $dir,$url.'/'.$path)) {
                   9972:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9973:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9974:             }
1.1075.2.11  raeburn  9975:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9976:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  9977:                   ($args->{'context'} eq 'paste')) ||
                   9978:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  9979:             if ($env{'request.course.id'} ne '') {
1.1075.2.35  raeburn  9980:                 my $dir;
                   9981:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9982:                     $dir = $fileloc;
                   9983:                 } else {
                   9984:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   9985:                 }
1.1071    raeburn  9986:                 if ($dir ne '') {
                   9987:                     my ($sublistref,$listerror) =
                   9988:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   9989:                     if (ref($sublistref) eq 'ARRAY') {
                   9990:                         foreach my $line (@{$sublistref}) {
                   9991:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   9992:                                 undef,$mtime)=split(/\&/,$line,12);
                   9993:                             unless (($testdir&$dirptr) ||
                   9994:                                     ($file_name =~ /^\.\.?$/)) {
                   9995:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   9996:                             }
                   9997:                         }
                   9998:                     }
                   9999:                 }
1.984     raeburn  10000:             }
                   10001:         }
                   10002:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  10003:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  10004:                 my $item = $path.'/'.$file;
                   10005:                 unless ($mapping{$item} eq $item) {
                   10006:                     $pathchanges{$item} = 1;
                   10007:                 }
                   10008:                 $existing{$item} = 1;
                   10009:                 $numexisting ++;
                   10010:             } else {
                   10011:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10012:             }
                   10013:         }
1.1071    raeburn  10014:         if ($actionurl eq '/adm/dependencies') {
                   10015:             foreach my $path (keys(%currsubfile)) {
                   10016:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10017:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10018:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  10019:                              next if (($rem ne '') &&
                   10020:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10021:                                        (ref($navmap) &&
                   10022:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10023:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10024:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10025:                              $unused{$path.'/'.$file} = 1; 
                   10026:                          }
                   10027:                     }
                   10028:                 }
                   10029:             }
                   10030:         }
1.984     raeburn  10031:     }
1.987     raeburn  10032:     my %currfile;
1.1075.2.35  raeburn  10033:     if (($actionurl eq '/adm/portfolio') ||
                   10034:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10035:         my ($dirlistref,$listerror) =
                   10036:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10037:         if (ref($dirlistref) eq 'ARRAY') {
                   10038:             foreach my $line (@{$dirlistref}) {
                   10039:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10040:                 $currfile{$file_name} = 1;
                   10041:             }
1.984     raeburn  10042:         }
1.987     raeburn  10043:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10044:         if (opendir(my $dir,$url)) {
1.987     raeburn  10045:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10046:             map {$currfile{$_} = 1;} @dir_list;
                   10047:         }
1.1075.2.11  raeburn  10048:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10049:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  10050:               ($args->{'context'} eq 'paste')) ||
                   10051:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10052:         if ($env{'request.course.id'} ne '') {
                   10053:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10054:             if ($dir ne '') {
                   10055:                 my ($dirlistref,$listerror) =
                   10056:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10057:                 if (ref($dirlistref) eq 'ARRAY') {
                   10058:                     foreach my $line (@{$dirlistref}) {
                   10059:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10060:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10061:                         unless (($testdir&$dirptr) ||
                   10062:                                 ($file_name =~ /^\.\.?$/)) {
                   10063:                             $currfile{$file_name} = [$size,$mtime];
                   10064:                         }
                   10065:                     }
                   10066:                 }
                   10067:             }
                   10068:         }
1.984     raeburn  10069:     }
                   10070:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10071:         if (exists($currfile{$file})) {
1.987     raeburn  10072:             unless ($mapping{$file} eq $file) {
                   10073:                 $pathchanges{$file} = 1;
                   10074:             }
                   10075:             $existing{$file} = 1;
                   10076:             $numexisting ++;
                   10077:         } else {
1.984     raeburn  10078:             $newfiles{$file} = 1;
                   10079:         }
                   10080:     }
1.1071    raeburn  10081:     foreach my $file (keys(%currfile)) {
                   10082:         unless (($file eq $filename) ||
                   10083:                 ($file eq $filename.'.bak') ||
                   10084:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  10085:             if ($actionurl eq '/adm/dependencies') {
1.1075.2.35  raeburn  10086:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10087:                     next if (($rem ne '') &&
                   10088:                              (($env{"httpref.$rem".$file} ne '') ||
                   10089:                               (ref($navmap) &&
                   10090:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10091:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10092:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10093:                 }
1.1075.2.11  raeburn  10094:             }
1.1071    raeburn  10095:             $unused{$file} = 1;
                   10096:         }
                   10097:     }
1.1075.2.11  raeburn  10098:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10099:         ($args->{'context'} eq 'paste')) {
                   10100:         $counter = scalar(keys(%existing));
                   10101:         $numpathchg = scalar(keys(%pathchanges));
                   10102:         return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35  raeburn  10103:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
                   10104:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10105:         $counter = scalar(keys(%existing));
                   10106:         $numpathchg = scalar(keys(%pathchanges));
                   10107:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11  raeburn  10108:     }
1.984     raeburn  10109:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10110:         if ($actionurl eq '/adm/dependencies') {
                   10111:             next if ($embed_file =~ m{^\w+://});
                   10112:         }
1.660     raeburn  10113:         $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10114:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10115:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10116:         unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35  raeburn  10117:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10118:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10119:         }
1.1075.2.35  raeburn  10120:         $upload_output .= '</td>';
1.1071    raeburn  10121:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1075.2.35  raeburn  10122:             $upload_output.='<td align="right">'.
                   10123:                             '<span class="LC_info LC_fontsize_medium">'.
                   10124:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10125:             $numremref++;
1.660     raeburn  10126:         } elsif ($args->{'error_on_invalid_names'}
                   10127:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35  raeburn  10128:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10129:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10130:             $numinvalid++;
1.660     raeburn  10131:         } else {
1.1075.2.35  raeburn  10132:             $upload_output .= '<td>'.
                   10133:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10134:                                                      $embed_file,\%mapping,
1.1071    raeburn  10135:                                                      $allfiles,$codebase,'upload');
                   10136:             $counter ++;
                   10137:             $numnew ++;
1.987     raeburn  10138:         }
                   10139:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10140:     }
                   10141:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10142:         if ($actionurl eq '/adm/dependencies') {
                   10143:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10144:             $modify_output .= &start_data_table_row().
                   10145:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10146:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10147:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10148:                               '<td>'.$size.'</td>'.
                   10149:                               '<td>'.$mtime.'</td>'.
                   10150:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10151:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10152:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10153:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10154:                               &embedded_file_element('upload_embedded',$counter,
                   10155:                                                      $embed_file,\%mapping,
                   10156:                                                      $allfiles,$codebase,'modify').
                   10157:                               '</div></td>'.
                   10158:                               &end_data_table_row()."\n";
                   10159:             $counter ++;
                   10160:         } else {
                   10161:             $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10162:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10163:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10164:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10165:                               &Apache::loncommon::end_data_table_row()."\n";
                   10166:         }
                   10167:     }
                   10168:     my $delidx = $counter;
                   10169:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10170:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10171:         $delete_output .= &start_data_table_row().
                   10172:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10173:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10174:                           '<td>'.$size.'</td>'.
                   10175:                           '<td>'.$mtime.'</td>'.
                   10176:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10177:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10178:                           &embedded_file_element('upload_embedded',$delidx,
                   10179:                                                  $oldfile,\%mapping,$allfiles,
                   10180:                                                  $codebase,'delete').'</td>'.
                   10181:                           &end_data_table_row()."\n"; 
                   10182:         $numunused ++;
                   10183:         $delidx ++;
1.987     raeburn  10184:     }
                   10185:     if ($upload_output) {
                   10186:         $upload_output = &start_data_table().
                   10187:                          $upload_output.
                   10188:                          &end_data_table()."\n";
                   10189:     }
1.1071    raeburn  10190:     if ($modify_output) {
                   10191:         $modify_output = &start_data_table().
                   10192:                          &start_data_table_header_row().
                   10193:                          '<th>'.&mt('File').'</th>'.
                   10194:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10195:                          '<th>'.&mt('Modified').'</th>'.
                   10196:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10197:                          &end_data_table_header_row().
                   10198:                          $modify_output.
                   10199:                          &end_data_table()."\n";
                   10200:     }
                   10201:     if ($delete_output) {
                   10202:         $delete_output = &start_data_table().
                   10203:                          &start_data_table_header_row().
                   10204:                          '<th>'.&mt('File').'</th>'.
                   10205:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10206:                          '<th>'.&mt('Modified').'</th>'.
                   10207:                          '<th>'.&mt('Delete?').'</th>'.
                   10208:                          &end_data_table_header_row().
                   10209:                          $delete_output.
                   10210:                          &end_data_table()."\n";
                   10211:     }
1.987     raeburn  10212:     my $applies = 0;
                   10213:     if ($numremref) {
                   10214:         $applies ++;
                   10215:     }
                   10216:     if ($numinvalid) {
                   10217:         $applies ++;
                   10218:     }
                   10219:     if ($numexisting) {
                   10220:         $applies ++;
                   10221:     }
1.1071    raeburn  10222:     if ($counter || $numunused) {
1.987     raeburn  10223:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10224:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10225:                   $state.'<h3>'.$heading.'</h3>'; 
                   10226:         if ($actionurl eq '/adm/dependencies') {
                   10227:             if ($numnew) {
                   10228:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10229:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10230:                            $upload_output.'<br />'."\n";
                   10231:             }
                   10232:             if ($numexisting) {
                   10233:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10234:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10235:                            $modify_output.'<br />'."\n";
                   10236:                            $buttontext = &mt('Save changes');
                   10237:             }
                   10238:             if ($numunused) {
                   10239:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10240:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10241:                            $delete_output.'<br />'."\n";
                   10242:                            $buttontext = &mt('Save changes');
                   10243:             }
                   10244:         } else {
                   10245:             $output .= $upload_output.'<br />'."\n";
                   10246:         }
                   10247:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10248:                    $counter.'" />'."\n";
                   10249:         if ($actionurl eq '/adm/dependencies') { 
                   10250:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10251:                        $numnew.'" />'."\n";
                   10252:         } elsif ($actionurl eq '') {
1.987     raeburn  10253:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10254:         }
                   10255:     } elsif ($applies) {
                   10256:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10257:         if ($applies > 1) {
                   10258:             $output .=  
1.1075.2.35  raeburn  10259:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10260:             if ($numremref) {
                   10261:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10262:             }
                   10263:             if ($numinvalid) {
                   10264:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10265:             }
                   10266:             if ($numexisting) {
                   10267:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10268:             }
                   10269:             $output .= '</ul><br />';
                   10270:         } elsif ($numremref) {
                   10271:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10272:         } elsif ($numinvalid) {
                   10273:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10274:         } elsif ($numexisting) {
                   10275:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10276:         }
                   10277:         $output .= $upload_output.'<br />';
                   10278:     }
                   10279:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10280:     $chgcount = $counter;
1.987     raeburn  10281:     if (keys(%pathchanges) > 0) {
                   10282:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10283:             if ($counter) {
1.987     raeburn  10284:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10285:                                                   $embed_file,\%mapping,
1.1071    raeburn  10286:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10287:             } else {
                   10288:                 $pathchange_output .= 
                   10289:                     &start_data_table_row().
                   10290:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10291:                     $chgcount.'" checked="checked" /></td>'.
                   10292:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10293:                     '<td>'.$embed_file.
                   10294:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10295:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10296:                     '</td>'.&end_data_table_row();
1.660     raeburn  10297:             }
1.987     raeburn  10298:             $numpathchg ++;
                   10299:             $chgcount ++;
1.660     raeburn  10300:         }
                   10301:     }
1.1075.2.35  raeburn  10302:     if (($counter) || ($numunused)) {
1.987     raeburn  10303:         if ($numpathchg) {
                   10304:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10305:                        $numpathchg.'" />'."\n";
                   10306:         }
                   10307:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10308:             ($actionurl eq '/adm/imsimport')) {
                   10309:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10310:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10311:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10312:         } elsif ($actionurl eq '/adm/dependencies') {
                   10313:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10314:         }
1.1075.2.35  raeburn  10315:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10316:     } elsif ($numpathchg) {
                   10317:         my %pathchange = ();
                   10318:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10319:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10320:             $output .= '<p>'.&mt('or').'</p>'; 
1.1075.2.35  raeburn  10321:         }
1.987     raeburn  10322:     }
1.1071    raeburn  10323:     return ($output,$counter,$numpathchg);
1.987     raeburn  10324: }
                   10325: 
1.1075.2.47  raeburn  10326: =pod
                   10327: 
                   10328: =item * clean_path($name)
                   10329: 
                   10330: Performs clean-up of directories, subdirectories and filename in an
                   10331: embedded object, referenced in an HTML file which is being uploaded
                   10332: to a course or portfolio, where
                   10333: "Upload embedded images/multimedia files if HTML file" checkbox was
                   10334: checked.
                   10335: 
                   10336: Clean-up is similar to replacements in lonnet::clean_filename()
                   10337: except each / between sub-directory and next level is preserved.
                   10338: 
                   10339: =cut
                   10340: 
                   10341: sub clean_path {
                   10342:     my ($embed_file) = @_;
                   10343:     $embed_file =~s{^/+}{};
                   10344:     my @contents;
                   10345:     if ($embed_file =~ m{/}) {
                   10346:         @contents = split(/\//,$embed_file);
                   10347:     } else {
                   10348:         @contents = ($embed_file);
                   10349:     }
                   10350:     my $lastidx = scalar(@contents)-1;
                   10351:     for (my $i=0; $i<=$lastidx; $i++) {
                   10352:         $contents[$i]=~s{\\}{/}g;
                   10353:         $contents[$i]=~s/\s+/\_/g;
                   10354:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   10355:         if ($i == $lastidx) {
                   10356:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   10357:         }
                   10358:     }
                   10359:     if ($lastidx > 0) {
                   10360:         return join('/',@contents);
                   10361:     } else {
                   10362:         return $contents[0];
                   10363:     }
                   10364: }
                   10365: 
1.987     raeburn  10366: sub embedded_file_element {
1.1071    raeburn  10367:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10368:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10369:                    (ref($codebase) eq 'HASH'));
                   10370:     my $output;
1.1071    raeburn  10371:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10372:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10373:     }
                   10374:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10375:                &escape($embed_file).'" />';
                   10376:     unless (($context eq 'upload_embedded') && 
                   10377:             ($mapping->{$embed_file} eq $embed_file)) {
                   10378:         $output .='
                   10379:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10380:     }
                   10381:     my $attrib;
                   10382:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10383:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10384:     }
                   10385:     $output .=
                   10386:         "\n\t\t".
                   10387:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10388:         $attrib.'" />';
                   10389:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10390:         $output .=
                   10391:             "\n\t\t".
                   10392:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10393:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10394:     }
1.987     raeburn  10395:     return $output;
1.660     raeburn  10396: }
                   10397: 
1.1071    raeburn  10398: sub get_dependency_details {
                   10399:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10400:     my ($size,$mtime,$showsize,$showmtime);
                   10401:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10402:         if ($embed_file =~ m{/}) {
                   10403:             my ($path,$fname) = split(/\//,$embed_file);
                   10404:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10405:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10406:             }
                   10407:         } else {
                   10408:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10409:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10410:             }
                   10411:         }
                   10412:         $showsize = $size/1024.0;
                   10413:         $showsize = sprintf("%.1f",$showsize);
                   10414:         if ($mtime > 0) {
                   10415:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10416:         }
                   10417:     }
                   10418:     return ($showsize,$showmtime);
                   10419: }
                   10420: 
                   10421: sub ask_embedded_js {
                   10422:     return <<"END";
                   10423: <script type="text/javascript"">
                   10424: // <![CDATA[
                   10425: function toggleBrowse(counter) {
                   10426:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10427:     var fileid = document.getElementById('embedded_item_'+counter);
                   10428:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10429:     if (chkboxid.checked == true) {
                   10430:         uploaddivid.style.display='block';
                   10431:     } else {
                   10432:         uploaddivid.style.display='none';
                   10433:         fileid.value = '';
                   10434:     }
                   10435: }
                   10436: // ]]>
                   10437: </script>
                   10438: 
                   10439: END
                   10440: }
                   10441: 
1.661     raeburn  10442: sub upload_embedded {
                   10443:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10444:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10445:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10446:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10447:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10448:         my $orig_uploaded_filename =
                   10449:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10450:         foreach my $type ('orig','ref','attrib','codebase') {
                   10451:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10452:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10453:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10454:             }
                   10455:         }
1.661     raeburn  10456:         my ($path,$fname) =
                   10457:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10458:         # no path, whole string is fname
                   10459:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10460:         $fname = &Apache::lonnet::clean_filename($fname);
                   10461:         # See if there is anything left
                   10462:         next if ($fname eq '');
                   10463: 
                   10464:         # Check if file already exists as a file or directory.
                   10465:         my ($state,$msg);
                   10466:         if ($context eq 'portfolio') {
                   10467:             my $port_path = $dirpath;
                   10468:             if ($group ne '') {
                   10469:                 $port_path = "groups/$group/$port_path";
                   10470:             }
1.987     raeburn  10471:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10472:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10473:                                               $dir_root,$port_path,$disk_quota,
                   10474:                                               $current_disk_usage,$uname,$udom);
                   10475:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10476:                 || $state eq 'file_locked') {
1.661     raeburn  10477:                 $output .= $msg;
                   10478:                 next;
                   10479:             }
                   10480:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10481:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10482:             if ($state eq 'exists') {
                   10483:                 $output .= $msg;
                   10484:                 next;
                   10485:             }
                   10486:         }
                   10487:         # Check if extension is valid
                   10488:         if (($fname =~ /\.(\w+)$/) &&
                   10489:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53  raeburn  10490:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   10491:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  10492:             next;
                   10493:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10494:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10495:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10496:             next;
                   10497:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34  raeburn  10498:             $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  10499:             next;
                   10500:         }
                   10501:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35  raeburn  10502:         my $subdir = $path;
                   10503:         $subdir =~ s{/+$}{};
1.661     raeburn  10504:         if ($context eq 'portfolio') {
1.984     raeburn  10505:             my $result;
                   10506:             if ($state eq 'existingfile') {
                   10507:                 $result=
                   10508:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35  raeburn  10509:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  10510:             } else {
1.984     raeburn  10511:                 $result=
                   10512:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10513:                                                     $dirpath.
1.1075.2.35  raeburn  10514:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  10515:                 if ($result !~ m|^/uploaded/|) {
                   10516:                     $output .= '<span class="LC_error">'
                   10517:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10518:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10519:                                .'</span><br />';
                   10520:                     next;
                   10521:                 } else {
1.987     raeburn  10522:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10523:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10524:                 }
1.661     raeburn  10525:             }
1.1075.2.35  raeburn  10526:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
                   10527:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   10528:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  10529:             my $result =
1.1075.2.35  raeburn  10530:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  10531:             if ($result !~ m|^/uploaded/|) {
                   10532:                 $output .= '<span class="LC_error">'
                   10533:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10534:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10535:                            .'</span><br />';
                   10536:                     next;
                   10537:             } else {
                   10538:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10539:                            $path.$fname.'</span>').'<br />';
1.1075.2.35  raeburn  10540:                 if ($context eq 'syllabus') {
                   10541:                     &Apache::lonnet::make_public_indefinitely($result);
                   10542:                 }
1.987     raeburn  10543:             }
1.661     raeburn  10544:         } else {
                   10545: # Save the file
                   10546:             my $target = $env{'form.embedded_item_'.$i};
                   10547:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10548:             my $dest = $fullpath.$fname;
                   10549:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10550:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10551:             my $count;
                   10552:             my $filepath = $dir_root;
1.1027    raeburn  10553:             foreach my $subdir (@parts) {
                   10554:                 $filepath .= "/$subdir";
                   10555:                 if (!-e $filepath) {
1.661     raeburn  10556:                     mkdir($filepath,0770);
                   10557:                 }
                   10558:             }
                   10559:             my $fh;
                   10560:             if (!open($fh,'>'.$dest)) {
                   10561:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10562:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10563:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10564:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10565:                            '</span><br />';
                   10566:             } else {
                   10567:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10568:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10569:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10570:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10571:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10572:                               '</span><br />';
                   10573:                 } else {
1.987     raeburn  10574:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10575:                                $url.'</span>').'<br />';
                   10576:                     unless ($context eq 'testbank') {
                   10577:                         $footer .= &mt('View embedded file: [_1]',
                   10578:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10579:                     }
                   10580:                 }
                   10581:                 close($fh);
                   10582:             }
                   10583:         }
                   10584:         if ($env{'form.embedded_ref_'.$i}) {
                   10585:             $pathchange{$i} = 1;
                   10586:         }
                   10587:     }
                   10588:     if ($output) {
                   10589:         $output = '<p>'.$output.'</p>';
                   10590:     }
                   10591:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10592:     $returnflag = 'ok';
1.1071    raeburn  10593:     my $numpathchgs = scalar(keys(%pathchange));
                   10594:     if ($numpathchgs > 0) {
1.987     raeburn  10595:         if ($context eq 'portfolio') {
                   10596:             $output .= '<p>'.&mt('or').'</p>';
                   10597:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10598:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10599:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10600:             $returnflag = 'modify_orightml';
                   10601:         }
                   10602:     }
1.1071    raeburn  10603:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10604: }
                   10605: 
                   10606: sub modify_html_form {
                   10607:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10608:     my $end = 0;
                   10609:     my $modifyform;
                   10610:     if ($context eq 'upload_embedded') {
                   10611:         return unless (ref($pathchange) eq 'HASH');
                   10612:         if ($env{'form.number_embedded_items'}) {
                   10613:             $end += $env{'form.number_embedded_items'};
                   10614:         }
                   10615:         if ($env{'form.number_pathchange_items'}) {
                   10616:             $end += $env{'form.number_pathchange_items'};
                   10617:         }
                   10618:         if ($end) {
                   10619:             for (my $i=0; $i<$end; $i++) {
                   10620:                 if ($i < $env{'form.number_embedded_items'}) {
                   10621:                     next unless($pathchange->{$i});
                   10622:                 }
                   10623:                 $modifyform .=
                   10624:                     &start_data_table_row().
                   10625:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10626:                     'checked="checked" /></td>'.
                   10627:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10628:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10629:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10630:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10631:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10632:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10633:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10634:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10635:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10636:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10637:                     &end_data_table_row();
1.1071    raeburn  10638:             }
1.987     raeburn  10639:         }
                   10640:     } else {
                   10641:         $modifyform = $pathchgtable;
                   10642:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10643:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10644:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10645:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10646:         }
                   10647:     }
                   10648:     if ($modifyform) {
1.1071    raeburn  10649:         if ($actionurl eq '/adm/dependencies') {
                   10650:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10651:         }
1.987     raeburn  10652:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10653:                '<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".
                   10654:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10655:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10656:                '</ol></p>'."\n".'<p>'.
                   10657:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10658:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10659:                &start_data_table()."\n".
                   10660:                &start_data_table_header_row().
                   10661:                '<th>'.&mt('Change?').'</th>'.
                   10662:                '<th>'.&mt('Current reference').'</th>'.
                   10663:                '<th>'.&mt('Required reference').'</th>'.
                   10664:                &end_data_table_header_row()."\n".
                   10665:                $modifyform.
                   10666:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10667:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10668:                '</form>'."\n";
                   10669:     }
                   10670:     return;
                   10671: }
                   10672: 
                   10673: sub modify_html_refs {
1.1075.2.35  raeburn  10674:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  10675:     my $container;
                   10676:     if ($context eq 'portfolio') {
                   10677:         $container = $env{'form.container'};
                   10678:     } elsif ($context eq 'coursedoc') {
                   10679:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10680:     } elsif ($context eq 'manage_dependencies') {
                   10681:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10682:         $container = "/$container";
1.1075.2.35  raeburn  10683:     } elsif ($context eq 'syllabus') {
                   10684:         $container = $url;
1.987     raeburn  10685:     } else {
1.1027    raeburn  10686:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10687:     }
                   10688:     my (%allfiles,%codebase,$output,$content);
                   10689:     my @changes = &get_env_multiple('form.namechange');
1.1075.2.35  raeburn  10690:     unless ((@changes > 0)  || ($context eq 'syllabus')) {
1.1071    raeburn  10691:         if (wantarray) {
                   10692:             return ('',0,0); 
                   10693:         } else {
                   10694:             return;
                   10695:         }
                   10696:     }
                   10697:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10698:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  10699:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10700:             if (wantarray) {
                   10701:                 return ('',0,0);
                   10702:             } else {
                   10703:                 return;
                   10704:             }
                   10705:         } 
1.987     raeburn  10706:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10707:         if ($content eq '-1') {
                   10708:             if (wantarray) {
                   10709:                 return ('',0,0);
                   10710:             } else {
                   10711:                 return;
                   10712:             }
                   10713:         }
1.987     raeburn  10714:     } else {
1.1071    raeburn  10715:         unless ($container =~ /^\Q$dir_root\E/) {
                   10716:             if (wantarray) {
                   10717:                 return ('',0,0);
                   10718:             } else {
                   10719:                 return;
                   10720:             }
                   10721:         } 
1.987     raeburn  10722:         if (open(my $fh,"<$container")) {
                   10723:             $content = join('', <$fh>);
                   10724:             close($fh);
                   10725:         } else {
1.1071    raeburn  10726:             if (wantarray) {
                   10727:                 return ('',0,0);
                   10728:             } else {
                   10729:                 return;
                   10730:             }
1.987     raeburn  10731:         }
                   10732:     }
                   10733:     my ($count,$codebasecount) = (0,0);
                   10734:     my $mm = new File::MMagic;
                   10735:     my $mime_type = $mm->checktype_contents($content);
                   10736:     if ($mime_type eq 'text/html') {
                   10737:         my $parse_result = 
                   10738:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10739:                                                     \%codebase,\$content);
                   10740:         if ($parse_result eq 'ok') {
                   10741:             foreach my $i (@changes) {
                   10742:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10743:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10744:                 if ($allfiles{$ref}) {
                   10745:                     my $newname =  $orig;
                   10746:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10747:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10748:                     if ($attrib_regexp =~ /:/) {
                   10749:                         $attrib_regexp =~ s/\:/|/g;
                   10750:                     }
                   10751:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10752:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10753:                         $count += $numchg;
1.1075.2.35  raeburn  10754:                         $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48  raeburn  10755:                         delete($allfiles{$ref});
1.987     raeburn  10756:                     }
                   10757:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10758:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10759:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10760:                         $codebasecount ++;
                   10761:                     }
                   10762:                 }
                   10763:             }
1.1075.2.35  raeburn  10764:             my $skiprewrites;
1.987     raeburn  10765:             if ($count || $codebasecount) {
                   10766:                 my $saveresult;
1.1071    raeburn  10767:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10768:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  10769:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10770:                     if ($url eq $container) {
                   10771:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10772:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10773:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10774:                                             $fname.'</span>').'</p>';
1.987     raeburn  10775:                     } else {
                   10776:                          $output = '<p class="LC_error">'.
                   10777:                                    &mt('Error: update failed for: [_1].',
                   10778:                                    '<span class="LC_filename">'.
                   10779:                                    $container.'</span>').'</p>';
                   10780:                     }
1.1075.2.35  raeburn  10781:                     if ($context eq 'syllabus') {
                   10782:                         unless ($saveresult eq 'ok') {
                   10783:                             $skiprewrites = 1;
                   10784:                         }
                   10785:                     }
1.987     raeburn  10786:                 } else {
                   10787:                     if (open(my $fh,">$container")) {
                   10788:                         print $fh $content;
                   10789:                         close($fh);
                   10790:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10791:                                   $count,'<span class="LC_filename">'.
                   10792:                                   $container.'</span>').'</p>';
1.661     raeburn  10793:                     } else {
1.987     raeburn  10794:                          $output = '<p class="LC_error">'.
                   10795:                                    &mt('Error: could not update [_1].',
                   10796:                                    '<span class="LC_filename">'.
                   10797:                                    $container.'</span>').'</p>';
1.661     raeburn  10798:                     }
                   10799:                 }
                   10800:             }
1.1075.2.35  raeburn  10801:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   10802:                 my ($actionurl,$state);
                   10803:                 $actionurl = "/public/$udom/$uname/syllabus";
                   10804:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   10805:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   10806:                                               \%codebase,
                   10807:                                               {'context' => 'rewrites',
                   10808:                                                'ignore_remote_references' => 1,});
                   10809:                 if (ref($mapping) eq 'HASH') {
                   10810:                     my $rewrites = 0;
                   10811:                     foreach my $key (keys(%{$mapping})) {
                   10812:                         next if ($key =~ m{^https?://});
                   10813:                         my $ref = $mapping->{$key};
                   10814:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   10815:                         my $attrib;
                   10816:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   10817:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   10818:                         }
                   10819:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10820:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10821:                             $rewrites += $numchg;
                   10822:                         }
                   10823:                     }
                   10824:                     if ($rewrites) {
                   10825:                         my $saveresult;
                   10826:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10827:                         if ($url eq $container) {
                   10828:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   10829:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   10830:                                             $count,'<span class="LC_filename">'.
                   10831:                                             $fname.'</span>').'</p>';
                   10832:                         } else {
                   10833:                             $output .= '<p class="LC_error">'.
                   10834:                                        &mt('Error: could not update links in [_1].',
                   10835:                                        '<span class="LC_filename">'.
                   10836:                                        $container.'</span>').'</p>';
                   10837: 
                   10838:                         }
                   10839:                     }
                   10840:                 }
                   10841:             }
1.987     raeburn  10842:         } else {
                   10843:             &logthis('Failed to parse '.$container.
                   10844:                      ' to modify references: '.$parse_result);
1.661     raeburn  10845:         }
                   10846:     }
1.1071    raeburn  10847:     if (wantarray) {
                   10848:         return ($output,$count,$codebasecount);
                   10849:     } else {
                   10850:         return $output;
                   10851:     }
1.661     raeburn  10852: }
                   10853: 
                   10854: sub check_for_existing {
                   10855:     my ($path,$fname,$element) = @_;
                   10856:     my ($state,$msg);
                   10857:     if (-d $path.'/'.$fname) {
                   10858:         $state = 'exists';
                   10859:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10860:     } elsif (-e $path.'/'.$fname) {
                   10861:         $state = 'exists';
                   10862:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10863:     }
                   10864:     if ($state eq 'exists') {
                   10865:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10866:     }
                   10867:     return ($state,$msg);
                   10868: }
                   10869: 
                   10870: sub check_for_upload {
                   10871:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10872:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10873:     my $filesize = length($env{'form.'.$element});
                   10874:     if (!$filesize) {
                   10875:         my $msg = '<span class="LC_error">'.
                   10876:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10877:                       '<span class="LC_filename">'.$fname.'</span>',
                   10878:                       $filesize).'<br />'.
1.1007    raeburn  10879:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10880:                   '</span>';
                   10881:         return ('zero_bytes',$msg);
                   10882:     }
                   10883:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10884:     my $getpropath = 1;
1.1021    raeburn  10885:     my ($dirlistref,$listerror) =
                   10886:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10887:     my $found_file = 0;
                   10888:     my $locked_file = 0;
1.991     raeburn  10889:     my @lockers;
                   10890:     my $navmap;
                   10891:     if ($env{'request.course.id'}) {
                   10892:         $navmap = Apache::lonnavmaps::navmap->new();
                   10893:     }
1.1021    raeburn  10894:     if (ref($dirlistref) eq 'ARRAY') {
                   10895:         foreach my $line (@{$dirlistref}) {
                   10896:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10897:             if ($file_name eq $fname){
                   10898:                 $file_name = $path.$file_name;
                   10899:                 if ($group ne '') {
                   10900:                     $file_name = $group.$file_name;
                   10901:                 }
                   10902:                 $found_file = 1;
                   10903:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10904:                     foreach my $lock (@lockers) {
                   10905:                         if (ref($lock) eq 'ARRAY') {
                   10906:                             my ($symb,$crsid) = @{$lock};
                   10907:                             if ($crsid eq $env{'request.course.id'}) {
                   10908:                                 if (ref($navmap)) {
                   10909:                                     my $res = $navmap->getBySymb($symb);
                   10910:                                     foreach my $part (@{$res->parts()}) { 
                   10911:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10912:                                         unless (($slot_status == $res->RESERVED) ||
                   10913:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10914:                                             $locked_file = 1;
                   10915:                                         }
1.991     raeburn  10916:                                     }
1.1021    raeburn  10917:                                 } else {
                   10918:                                     $locked_file = 1;
1.991     raeburn  10919:                                 }
                   10920:                             } else {
                   10921:                                 $locked_file = 1;
                   10922:                             }
                   10923:                         }
1.1021    raeburn  10924:                    }
                   10925:                 } else {
                   10926:                     my @info = split(/\&/,$rest);
                   10927:                     my $currsize = $info[6]/1000;
                   10928:                     if ($currsize < $filesize) {
                   10929:                         my $extra = $filesize - $currsize;
                   10930:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69  raeburn  10931:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  10932:                                       &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  10933:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   10934:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10935:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  10936:                             return ('will_exceed_quota',$msg);
                   10937:                         }
1.984     raeburn  10938:                     }
                   10939:                 }
1.661     raeburn  10940:             }
                   10941:         }
                   10942:     }
                   10943:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69  raeburn  10944:         my $msg = '<p class="LC_warning">'.
                   10945:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
                   10946:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  10947:         return ('will_exceed_quota',$msg);
                   10948:     } elsif ($found_file) {
                   10949:         if ($locked_file) {
1.1075.2.69  raeburn  10950:             my $msg = '<p class="LC_warning">';
1.661     raeburn  10951:             $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  10952:             $msg .= '</p>';
1.661     raeburn  10953:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10954:             return ('file_locked',$msg);
                   10955:         } else {
1.1075.2.69  raeburn  10956:             my $msg = '<p class="LC_error">';
1.984     raeburn  10957:             $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  10958:             $msg .= '</p>';
1.984     raeburn  10959:             return ('existingfile',$msg);
1.661     raeburn  10960:         }
                   10961:     }
                   10962: }
                   10963: 
1.987     raeburn  10964: sub check_for_traversal {
                   10965:     my ($path,$url,$toplevel) = @_;
                   10966:     my @parts=split(/\//,$path);
                   10967:     my $cleanpath;
                   10968:     my $fullpath = $url;
                   10969:     for (my $i=0;$i<@parts;$i++) {
                   10970:         next if ($parts[$i] eq '.');
                   10971:         if ($parts[$i] eq '..') {
                   10972:             $fullpath =~ s{([^/]+/)$}{};
                   10973:         } else {
                   10974:             $fullpath .= $parts[$i].'/';
                   10975:         }
                   10976:     }
                   10977:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10978:         $cleanpath = $1;
                   10979:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   10980:         my $curr_toprel = $1;
                   10981:         my @parts = split(/\//,$curr_toprel);
                   10982:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   10983:         my @urlparts = split(/\//,$url_toprel);
                   10984:         my $doubledots;
                   10985:         my $startdiff = -1;
                   10986:         for (my $i=0; $i<@urlparts; $i++) {
                   10987:             if ($startdiff == -1) {
                   10988:                 unless ($urlparts[$i] eq $parts[$i]) {
                   10989:                     $startdiff = $i;
                   10990:                     $doubledots .= '../';
                   10991:                 }
                   10992:             } else {
                   10993:                 $doubledots .= '../';
                   10994:             }
                   10995:         }
                   10996:         if ($startdiff > -1) {
                   10997:             $cleanpath = $doubledots;
                   10998:             for (my $i=$startdiff; $i<@parts; $i++) {
                   10999:                 $cleanpath .= $parts[$i].'/';
                   11000:             }
                   11001:         }
                   11002:     }
                   11003:     $cleanpath =~ s{(/)$}{};
                   11004:     return $cleanpath;
                   11005: }
1.31      albertel 11006: 
1.1053    raeburn  11007: sub is_archive_file {
                   11008:     my ($mimetype) = @_;
                   11009:     if (($mimetype eq 'application/octet-stream') ||
                   11010:         ($mimetype eq 'application/x-stuffit') ||
                   11011:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11012:         return 1;
                   11013:     }
                   11014:     return;
                   11015: }
                   11016: 
                   11017: sub decompress_form {
1.1065    raeburn  11018:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11019:     my %lt = &Apache::lonlocal::texthash (
                   11020:         this => 'This file is an archive file.',
1.1067    raeburn  11021:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11022:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11023:         youm => 'You may wish to extract its contents.',
                   11024:         extr => 'Extract contents',
1.1067    raeburn  11025:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11026:         proa => 'Process automatically?',
1.1053    raeburn  11027:         yes  => 'Yes',
                   11028:         no   => 'No',
1.1067    raeburn  11029:         fold => 'Title for folder containing movie',
                   11030:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11031:     );
1.1065    raeburn  11032:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11033:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11034:     my $info = &list_archive_contents($fileloc,\@paths);
                   11035:     if (@paths) {
                   11036:         foreach my $path (@paths) {
                   11037:             $path =~ s{^/}{};
1.1067    raeburn  11038:             if ($path =~ m{^([^/]+)/$}) {
                   11039:                 $topdir = $1;
                   11040:             }
1.1065    raeburn  11041:             if ($path =~ m{^([^/]+)/}) {
                   11042:                 $toplevel{$1} = $path;
                   11043:             } else {
                   11044:                 $toplevel{$path} = $path;
                   11045:             }
                   11046:         }
                   11047:     }
1.1067    raeburn  11048:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59  raeburn  11049:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11050:                         "$topdir/media/",
                   11051:                         "$topdir/media/$topdir.mp4",
                   11052:                         "$topdir/media/FirstFrame.png",
                   11053:                         "$topdir/media/player.swf",
                   11054:                         "$topdir/media/swfobject.js",
                   11055:                         "$topdir/media/expressInstall.swf");
1.1075.2.59  raeburn  11056:         my @camtasia8 = ("$topdir/","$topdir/$topdir.html",
                   11057:                          "$topdir/$topdir.mp4",
                   11058:                          "$topdir/$topdir\_config.xml",
                   11059:                          "$topdir/$topdir\_controller.swf",
                   11060:                          "$topdir/$topdir\_embed.css",
                   11061:                          "$topdir/$topdir\_First_Frame.png",
                   11062:                          "$topdir/$topdir\_player.html",
                   11063:                          "$topdir/$topdir\_Thumbnails.png",
                   11064:                          "$topdir/playerProductInstall.swf",
                   11065:                          "$topdir/scripts/",
                   11066:                          "$topdir/scripts/config_xml.js",
                   11067:                          "$topdir/scripts/handlebars.js",
                   11068:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11069:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11070:                          "$topdir/scripts/modernizr.js",
                   11071:                          "$topdir/scripts/player-min.js",
                   11072:                          "$topdir/scripts/swfobject.js",
                   11073:                          "$topdir/skins/",
                   11074:                          "$topdir/skins/configuration_express.xml",
                   11075:                          "$topdir/skins/express_show/",
                   11076:                          "$topdir/skins/express_show/player-min.css",
                   11077:                          "$topdir/skins/express_show/spritesheet.png");
                   11078:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11079:         if (@diffs == 0) {
1.1075.2.59  raeburn  11080:             $is_camtasia = 6;
                   11081:         } else {
                   11082:             @diffs = &compare_arrays(\@paths,\@camtasia8);
                   11083:             if (@diffs == 0) {
                   11084:                 $is_camtasia = 8;
                   11085:             }
1.1067    raeburn  11086:         }
                   11087:     }
                   11088:     my $output;
                   11089:     if ($is_camtasia) {
                   11090:         $output = <<"ENDCAM";
                   11091: <script type="text/javascript" language="Javascript">
                   11092: // <![CDATA[
                   11093: 
                   11094: function camtasiaToggle() {
                   11095:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11096:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59  raeburn  11097:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11098:                 document.getElementById('camtasia_titles').style.display='block';
                   11099:             } else {
                   11100:                 document.getElementById('camtasia_titles').style.display='none';
                   11101:             }
                   11102:         }
                   11103:     }
                   11104:     return;
                   11105: }
                   11106: 
                   11107: // ]]>
                   11108: </script>
                   11109: <p>$lt{'camt'}</p>
                   11110: ENDCAM
1.1065    raeburn  11111:     } else {
1.1067    raeburn  11112:         $output = '<p>'.$lt{'this'};
                   11113:         if ($info eq '') {
                   11114:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11115:         } else {
                   11116:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11117:                        '<div><pre>'.$info.'</pre></div>';
                   11118:         }
1.1065    raeburn  11119:     }
1.1067    raeburn  11120:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11121:     my $duplicates;
                   11122:     my $num = 0;
                   11123:     if (ref($dirlist) eq 'ARRAY') {
                   11124:         foreach my $item (@{$dirlist}) {
                   11125:             if (ref($item) eq 'ARRAY') {
                   11126:                 if (exists($toplevel{$item->[0]})) {
                   11127:                     $duplicates .= 
                   11128:                         &start_data_table_row().
                   11129:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11130:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11131:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11132:                         'value="1" />'.&mt('Yes').'</label>'.
                   11133:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11134:                         '<td>'.$item->[0].'</td>';
                   11135:                     if ($item->[2]) {
                   11136:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11137:                     } else {
                   11138:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11139:                     }
                   11140:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11141:                                    '<td>'.
                   11142:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11143:                                    '</td>'.
                   11144:                                    &end_data_table_row();
                   11145:                     $num ++;
                   11146:                 }
                   11147:             }
                   11148:         }
                   11149:     }
                   11150:     my $itemcount;
                   11151:     if (@paths > 0) {
                   11152:         $itemcount = scalar(@paths);
                   11153:     } else {
                   11154:         $itemcount = 1;
                   11155:     }
1.1067    raeburn  11156:     if ($is_camtasia) {
                   11157:         $output .= $lt{'auto'}.'<br />'.
                   11158:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59  raeburn  11159:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  11160:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11161:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11162:                    $lt{'no'}.'</label></span><br />'.
                   11163:                    '<div id="camtasia_titles" style="display:block">'.
                   11164:                    &Apache::lonhtmlcommon::start_pick_box().
                   11165:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11166:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11167:                    &Apache::lonhtmlcommon::row_closure().
                   11168:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11169:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11170:                    &Apache::lonhtmlcommon::row_closure(1).
                   11171:                    &Apache::lonhtmlcommon::end_pick_box().
                   11172:                    '</div>';
                   11173:     }
1.1065    raeburn  11174:     $output .= 
                   11175:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11176:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11177:         "\n";
1.1065    raeburn  11178:     if ($duplicates ne '') {
                   11179:         $output .= '<p><span class="LC_warning">'.
                   11180:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11181:                    &start_data_table().
                   11182:                    &start_data_table_header_row().
                   11183:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11184:                    '<th>'.&mt('Name').'</th>'.
                   11185:                    '<th>'.&mt('Type').'</th>'.
                   11186:                    '<th>'.&mt('Size').'</th>'.
                   11187:                    '<th>'.&mt('Last modified').'</th>'.
                   11188:                    &end_data_table_header_row().
                   11189:                    $duplicates.
                   11190:                    &end_data_table().
                   11191:                    '</p>';
                   11192:     }
1.1067    raeburn  11193:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11194:     if (ref($hiddenelements) eq 'HASH') {
                   11195:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11196:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11197:         }
                   11198:     }
                   11199:     $output .= <<"END";
1.1067    raeburn  11200: <br />
1.1053    raeburn  11201: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11202: </form>
                   11203: $noextract
                   11204: END
                   11205:     return $output;
                   11206: }
                   11207: 
1.1065    raeburn  11208: sub decompression_utility {
                   11209:     my ($program) = @_;
                   11210:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11211:     my $location;
                   11212:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11213:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11214:                          '/usr/sbin/') {
                   11215:             if (-x $dir.$program) {
                   11216:                 $location = $dir.$program;
                   11217:                 last;
                   11218:             }
                   11219:         }
                   11220:     }
                   11221:     return $location;
                   11222: }
                   11223: 
                   11224: sub list_archive_contents {
                   11225:     my ($file,$pathsref) = @_;
                   11226:     my (@cmd,$output);
                   11227:     my $needsregexp;
                   11228:     if ($file =~ /\.zip$/) {
                   11229:         @cmd = (&decompression_utility('unzip'),"-l");
                   11230:         $needsregexp = 1;
                   11231:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11232:              ($file =~ /\.tgz$/)) {
                   11233:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11234:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11235:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11236:     } elsif ($file =~ m|\.tar$|) {
                   11237:         @cmd = (&decompression_utility('tar'),"-tf");
                   11238:     }
                   11239:     if (@cmd) {
                   11240:         undef($!);
                   11241:         undef($@);
                   11242:         if (open(my $fh,"-|", @cmd, $file)) {
                   11243:             while (my $line = <$fh>) {
                   11244:                 $output .= $line;
                   11245:                 chomp($line);
                   11246:                 my $item;
                   11247:                 if ($needsregexp) {
                   11248:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11249:                 } else {
                   11250:                     $item = $line;
                   11251:                 }
                   11252:                 if ($item ne '') {
                   11253:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11254:                         push(@{$pathsref},$item);
                   11255:                     } 
                   11256:                 }
                   11257:             }
                   11258:             close($fh);
                   11259:         }
                   11260:     }
                   11261:     return $output;
                   11262: }
                   11263: 
1.1053    raeburn  11264: sub decompress_uploaded_file {
                   11265:     my ($file,$dir) = @_;
                   11266:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11267:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11268:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11269:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11270:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11271:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11272:     my $decompressed = $env{'cgi.decompressed'};
                   11273:     &Apache::lonnet::delenv('cgi.file');
                   11274:     &Apache::lonnet::delenv('cgi.dir');
                   11275:     &Apache::lonnet::delenv('cgi.decompressed');
                   11276:     return ($decompressed,$result);
                   11277: }
                   11278: 
1.1055    raeburn  11279: sub process_decompression {
                   11280:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11281:     my ($dir,$error,$warning,$output);
1.1075.2.69  raeburn  11282:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34  raeburn  11283:         $error = &mt('Filename not a supported archive file type.').
                   11284:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11285:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11286:     } else {
                   11287:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11288:         if ($docuhome eq 'no_host') {
                   11289:             $error = &mt('Could not determine home server for course.');
                   11290:         } else {
                   11291:             my @ids=&Apache::lonnet::current_machine_ids();
                   11292:             my $currdir = "$dir_root/$destination";
                   11293:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11294:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11295:                        "$dir_root/$destination";
                   11296:             } else {
                   11297:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11298:                        "$dir_root/$docudom/$docuname/$destination";
                   11299:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11300:                     $error = &mt('Archive file not found.');
                   11301:                 }
                   11302:             }
1.1065    raeburn  11303:             my (@to_overwrite,@to_skip);
                   11304:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11305:                 my $total = $env{'form.archive_overwrite_total'};
                   11306:                 for (my $i=0; $i<$total; $i++) {
                   11307:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11308:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11309:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11310:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11311:                     }
                   11312:                 }
                   11313:             }
                   11314:             my $numskip = scalar(@to_skip);
                   11315:             if (($numskip > 0) && 
                   11316:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11317:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11318:             } elsif ($dir eq '') {
1.1055    raeburn  11319:                 $error = &mt('Directory containing archive file unavailable.');
                   11320:             } elsif (!$error) {
1.1065    raeburn  11321:                 my ($decompressed,$display);
                   11322:                 if ($numskip > 0) {
                   11323:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11324:                     mkdir("$dir/$tempdir",0755);
                   11325:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11326:                     ($decompressed,$display) = 
                   11327:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11328:                     foreach my $item (@to_skip) {
                   11329:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11330:                             if (-f "$dir/$tempdir/$item") { 
                   11331:                                 unlink("$dir/$tempdir/$item");
                   11332:                             } elsif (-d "$dir/$tempdir/$item") {
                   11333:                                 system("rm -rf $dir/$tempdir/$item");
                   11334:                             }
                   11335:                         }
                   11336:                     }
                   11337:                     system("mv $dir/$tempdir/* $dir");
                   11338:                     rmdir("$dir/$tempdir");   
                   11339:                 } else {
                   11340:                     ($decompressed,$display) = 
                   11341:                         &decompress_uploaded_file($file,$dir);
                   11342:                 }
1.1055    raeburn  11343:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11344:                     $output = '<p class="LC_info">'.
                   11345:                               &mt('Files extracted successfully from archive.').
                   11346:                               '</p>'."\n";
1.1055    raeburn  11347:                     my ($warning,$result,@contents);
                   11348:                     my ($newdirlistref,$newlisterror) =
                   11349:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11350:                                                  $docuname,1);
                   11351:                     my (%is_dir,%changes,@newitems);
                   11352:                     my $dirptr = 16384;
1.1065    raeburn  11353:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11354:                         foreach my $dir_line (@{$newdirlistref}) {
                   11355:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11356:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11357:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11358:                                 push(@newitems,$item);
                   11359:                                 if ($dirptr&$testdir) {
                   11360:                                     $is_dir{$item} = 1;
                   11361:                                 }
                   11362:                                 $changes{$item} = 1;
                   11363:                             }
                   11364:                         }
                   11365:                     }
                   11366:                     if (keys(%changes) > 0) {
                   11367:                         foreach my $item (sort(@newitems)) {
                   11368:                             if ($changes{$item}) {
                   11369:                                 push(@contents,$item);
                   11370:                             }
                   11371:                         }
                   11372:                     }
                   11373:                     if (@contents > 0) {
1.1067    raeburn  11374:                         my $wantform;
                   11375:                         unless ($env{'form.autoextract_camtasia'}) {
                   11376:                             $wantform = 1;
                   11377:                         }
1.1056    raeburn  11378:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11379:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11380:                                                                 $currdir,\%is_dir,
                   11381:                                                                 \%children,\%parent,
1.1056    raeburn  11382:                                                                 \@contents,\%dirorder,
                   11383:                                                                 \%titles,$wantform);
1.1055    raeburn  11384:                         if ($datatable ne '') {
                   11385:                             $output .= &archive_options_form('decompressed',$datatable,
                   11386:                                                              $count,$hiddenelem);
1.1065    raeburn  11387:                             my $startcount = 6;
1.1055    raeburn  11388:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11389:                                                            \%titles,\%children);
1.1055    raeburn  11390:                         }
1.1067    raeburn  11391:                         if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59  raeburn  11392:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  11393:                             my %displayed;
                   11394:                             my $total = 1;
                   11395:                             $env{'form.archive_directory'} = [];
                   11396:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11397:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11398:                                 $path =~ s{/$}{};
                   11399:                                 my $item;
                   11400:                                 if ($path ne '') {
                   11401:                                     $item = "$path/$titles{$i}";
                   11402:                                 } else {
                   11403:                                     $item = $titles{$i};
                   11404:                                 }
                   11405:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11406:                                 if ($item eq $contents[0]) {
                   11407:                                     push(@{$env{'form.archive_directory'}},$i);
                   11408:                                     $env{'form.archive_'.$i} = 'display';
                   11409:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11410:                                     $displayed{'folder'} = $i;
1.1075.2.59  raeburn  11411:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   11412:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067    raeburn  11413:                                     $env{'form.archive_'.$i} = 'display';
                   11414:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11415:                                     $displayed{'web'} = $i;
                   11416:                                 } else {
1.1075.2.59  raeburn  11417:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   11418:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   11419:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  11420:                                         push(@{$env{'form.archive_directory'}},$i);
                   11421:                                     }
                   11422:                                     $env{'form.archive_'.$i} = 'dependency';
                   11423:                                 }
                   11424:                                 $total ++;
                   11425:                             }
                   11426:                             for (my $i=1; $i<$total; $i++) {
                   11427:                                 next if ($i == $displayed{'web'});
                   11428:                                 next if ($i == $displayed{'folder'});
                   11429:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11430:                             }
                   11431:                             $env{'form.phase'} = 'decompress_cleanup';
                   11432:                             $env{'form.archivedelete'} = 1;
                   11433:                             $env{'form.archive_count'} = $total-1;
                   11434:                             $output .=
                   11435:                                 &process_extracted_files('coursedocs',$docudom,
                   11436:                                                          $docuname,$destination,
                   11437:                                                          $dir_root,$hiddenelem);
                   11438:                         }
1.1055    raeburn  11439:                     } else {
                   11440:                         $warning = &mt('No new items extracted from archive file.');
                   11441:                     }
                   11442:                 } else {
                   11443:                     $output = $display;
                   11444:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11445:                 }
                   11446:             }
                   11447:         }
                   11448:     }
                   11449:     if ($error) {
                   11450:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11451:                    $error.'</p>'."\n";
                   11452:     }
                   11453:     if ($warning) {
                   11454:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11455:     }
                   11456:     return $output;
                   11457: }
                   11458: 
                   11459: sub get_extracted {
1.1056    raeburn  11460:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11461:         $titles,$wantform) = @_;
1.1055    raeburn  11462:     my $count = 0;
                   11463:     my $depth = 0;
                   11464:     my $datatable;
1.1056    raeburn  11465:     my @hierarchy;
1.1055    raeburn  11466:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11467:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11468:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11469:     foreach my $item (@{$contents}) {
                   11470:         $count ++;
1.1056    raeburn  11471:         @{$dirorder->{$count}} = @hierarchy;
                   11472:         $titles->{$count} = $item;
1.1055    raeburn  11473:         &archive_hierarchy($depth,$count,$parent,$children);
                   11474:         if ($wantform) {
                   11475:             $datatable .= &archive_row($is_dir->{$item},$item,
                   11476:                                        $currdir,$depth,$count);
                   11477:         }
                   11478:         if ($is_dir->{$item}) {
                   11479:             $depth ++;
1.1056    raeburn  11480:             push(@hierarchy,$count);
                   11481:             $parent->{$depth} = $count;
1.1055    raeburn  11482:             $datatable .=
                   11483:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  11484:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   11485:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  11486:             $depth --;
1.1056    raeburn  11487:             pop(@hierarchy);
1.1055    raeburn  11488:         }
                   11489:     }
                   11490:     return ($count,$datatable);
                   11491: }
                   11492: 
                   11493: sub recurse_extracted_archive {
1.1056    raeburn  11494:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   11495:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  11496:     my $result='';
1.1056    raeburn  11497:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   11498:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   11499:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  11500:         return $result;
                   11501:     }
                   11502:     my $dirptr = 16384;
                   11503:     my ($newdirlistref,$newlisterror) =
                   11504:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   11505:     if (ref($newdirlistref) eq 'ARRAY') {
                   11506:         foreach my $dir_line (@{$newdirlistref}) {
                   11507:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   11508:             unless ($item =~ /^\.+$/) {
                   11509:                 $$count ++;
1.1056    raeburn  11510:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   11511:                 $titles->{$$count} = $item;
1.1055    raeburn  11512:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  11513: 
1.1055    raeburn  11514:                 my $is_dir;
                   11515:                 if ($dirptr&$testdir) {
                   11516:                     $is_dir = 1;
                   11517:                 }
                   11518:                 if ($wantform) {
                   11519:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11520:                 }
                   11521:                 if ($is_dir) {
                   11522:                     $$depth ++;
1.1056    raeburn  11523:                     push(@{$hierarchy},$$count);
                   11524:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11525:                     $result .=
                   11526:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11527:                                                    $docuname,$depth,$count,
1.1056    raeburn  11528:                                                    $hierarchy,$dirorder,$children,
                   11529:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11530:                     $$depth --;
1.1056    raeburn  11531:                     pop(@{$hierarchy});
1.1055    raeburn  11532:                 }
                   11533:             }
                   11534:         }
                   11535:     }
                   11536:     return $result;
                   11537: }
                   11538: 
                   11539: sub archive_hierarchy {
                   11540:     my ($depth,$count,$parent,$children) =@_;
                   11541:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11542:         if (exists($parent->{$depth})) {
                   11543:              $children->{$parent->{$depth}} .= $count.':';
                   11544:         }
                   11545:     }
                   11546:     return;
                   11547: }
                   11548: 
                   11549: sub archive_row {
                   11550:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11551:     my ($name) = ($item =~ m{([^/]+)$});
                   11552:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11553:                                        'display'    => 'Add as file',
1.1055    raeburn  11554:                                        'dependency' => 'Include as dependency',
                   11555:                                        'discard'    => 'Discard',
                   11556:                                       );
                   11557:     if ($is_dir) {
1.1059    raeburn  11558:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11559:     }
1.1056    raeburn  11560:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11561:     my $offset = 0;
1.1055    raeburn  11562:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11563:         $offset ++;
1.1065    raeburn  11564:         if ($action ne 'display') {
                   11565:             $offset ++;
                   11566:         }  
1.1055    raeburn  11567:         $output .= '<td><span class="LC_nobreak">'.
                   11568:                    '<label><input type="radio" name="archive_'.$count.
                   11569:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11570:         my $text = $choices{$action};
                   11571:         if ($is_dir) {
                   11572:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11573:             if ($action eq 'display') {
1.1059    raeburn  11574:                 $text = &mt('Add as folder');
1.1055    raeburn  11575:             }
1.1056    raeburn  11576:         } else {
                   11577:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11578: 
                   11579:         }
                   11580:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11581:         if ($action eq 'dependency') {
                   11582:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11583:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11584:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11585:                        '<option value=""></option>'."\n".
                   11586:                        '</select>'."\n".
                   11587:                        '</div>';
1.1059    raeburn  11588:         } elsif ($action eq 'display') {
                   11589:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11590:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11591:                        '</div>';
1.1055    raeburn  11592:         }
1.1056    raeburn  11593:         $output .= '</td>';
1.1055    raeburn  11594:     }
                   11595:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11596:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11597:     for (my $i=0; $i<$depth; $i++) {
                   11598:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11599:     }
                   11600:     if ($is_dir) {
                   11601:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11602:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11603:     } else {
                   11604:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11605:     }
                   11606:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11607:                &end_data_table_row();
                   11608:     return $output;
                   11609: }
                   11610: 
                   11611: sub archive_options_form {
1.1065    raeburn  11612:     my ($form,$display,$count,$hiddenelem) = @_;
                   11613:     my %lt = &Apache::lonlocal::texthash(
                   11614:                perm => 'Permanently remove archive file?',
                   11615:                hows => 'How should each extracted item be incorporated in the course?',
                   11616:                cont => 'Content actions for all',
                   11617:                addf => 'Add as folder/file',
                   11618:                incd => 'Include as dependency for a displayed file',
                   11619:                disc => 'Discard',
                   11620:                no   => 'No',
                   11621:                yes  => 'Yes',
                   11622:                save => 'Save',
                   11623:     );
                   11624:     my $output = <<"END";
                   11625: <form name="$form" method="post" action="">
                   11626: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11627: <label>
                   11628:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11629: </label>
                   11630: &nbsp;
                   11631: <label>
                   11632:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11633: </span>
                   11634: </p>
                   11635: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11636: <br />$lt{'hows'}
                   11637: <div class="LC_columnSection">
                   11638:   <fieldset>
                   11639:     <legend>$lt{'cont'}</legend>
                   11640:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11641:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11642:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11643:   </fieldset>
                   11644: </div>
                   11645: END
                   11646:     return $output.
1.1055    raeburn  11647:            &start_data_table()."\n".
1.1065    raeburn  11648:            $display."\n".
1.1055    raeburn  11649:            &end_data_table()."\n".
                   11650:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11651:            $hiddenelem.
1.1065    raeburn  11652:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11653:            '</form>';
                   11654: }
                   11655: 
                   11656: sub archive_javascript {
1.1056    raeburn  11657:     my ($startcount,$numitems,$titles,$children) = @_;
                   11658:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11659:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11660:     my $scripttag = <<START;
                   11661: <script type="text/javascript">
                   11662: // <![CDATA[
                   11663: 
                   11664: function checkAll(form,prefix) {
                   11665:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11666:     for (var i=0; i < form.elements.length; i++) {
                   11667:         var id = form.elements[i].id;
                   11668:         if ((id != '') && (id != undefined)) {
                   11669:             if (idstr.test(id)) {
                   11670:                 if (form.elements[i].type == 'radio') {
                   11671:                     form.elements[i].checked = true;
1.1056    raeburn  11672:                     var nostart = i-$startcount;
1.1059    raeburn  11673:                     var offset = nostart%7;
                   11674:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11675:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11676:                 }
                   11677:             }
                   11678:         }
                   11679:     }
                   11680: }
                   11681: 
                   11682: function propagateCheck(form,count) {
                   11683:     if (count > 0) {
1.1059    raeburn  11684:         var startelement = $startcount + ((count-1) * 7);
                   11685:         for (var j=1; j<6; j++) {
                   11686:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11687:                 var item = startelement + j; 
                   11688:                 if (form.elements[item].type == 'radio') {
                   11689:                     if (form.elements[item].checked) {
                   11690:                         containerCheck(form,count,j);
                   11691:                         break;
                   11692:                     }
1.1055    raeburn  11693:                 }
                   11694:             }
                   11695:         }
                   11696:     }
                   11697: }
                   11698: 
                   11699: numitems = $numitems
1.1056    raeburn  11700: var titles = new Array(numitems);
                   11701: var parents = new Array(numitems);
1.1055    raeburn  11702: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11703:     parents[i] = new Array;
1.1055    raeburn  11704: }
1.1059    raeburn  11705: var maintitle = '$maintitle';
1.1055    raeburn  11706: 
                   11707: START
                   11708: 
1.1056    raeburn  11709:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11710:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11711:         for (my $i=0; $i<@contents; $i ++) {
                   11712:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11713:         }
                   11714:     }
                   11715: 
1.1056    raeburn  11716:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11717:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11718:     }
                   11719: 
1.1055    raeburn  11720:     $scripttag .= <<END;
                   11721: 
                   11722: function containerCheck(form,count,offset) {
                   11723:     if (count > 0) {
1.1056    raeburn  11724:         dependencyCheck(form,count,offset);
1.1059    raeburn  11725:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11726:         form.elements[item].checked = true;
                   11727:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11728:             if (parents[count].length > 0) {
                   11729:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11730:                     containerCheck(form,parents[count][j],offset);
                   11731:                 }
                   11732:             }
                   11733:         }
                   11734:     }
                   11735: }
                   11736: 
                   11737: function dependencyCheck(form,count,offset) {
                   11738:     if (count > 0) {
1.1059    raeburn  11739:         var chosen = (offset+$startcount)+7*(count-1);
                   11740:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11741:         var currtype = form.elements[depitem].type;
                   11742:         if (form.elements[chosen].value == 'dependency') {
                   11743:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11744:             form.elements[depitem].options.length = 0;
                   11745:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  11746:             for (var i=1; i<=numitems; i++) {
                   11747:                 if (i == count) {
                   11748:                     continue;
                   11749:                 }
1.1059    raeburn  11750:                 var startelement = $startcount + (i-1) * 7;
                   11751:                 for (var j=1; j<6; j++) {
                   11752:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11753:                         var item = startelement + j;
                   11754:                         if (form.elements[item].type == 'radio') {
                   11755:                             if (form.elements[item].checked) {
                   11756:                                 if (form.elements[item].value == 'display') {
                   11757:                                     var n = form.elements[depitem].options.length;
                   11758:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11759:                                 }
                   11760:                             }
                   11761:                         }
                   11762:                     }
                   11763:                 }
                   11764:             }
                   11765:         } else {
                   11766:             document.getElementById('arc_depon_'+count).style.display='none';
                   11767:             form.elements[depitem].options.length = 0;
                   11768:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11769:         }
1.1059    raeburn  11770:         titleCheck(form,count,offset);
1.1056    raeburn  11771:     }
                   11772: }
                   11773: 
                   11774: function propagateSelect(form,count,offset) {
                   11775:     if (count > 0) {
1.1065    raeburn  11776:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11777:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11778:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11779:             if (parents[count].length > 0) {
                   11780:                 for (var j=0; j<parents[count].length; j++) {
                   11781:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11782:                 }
                   11783:             }
                   11784:         }
                   11785:     }
                   11786: }
1.1056    raeburn  11787: 
                   11788: function containerSelect(form,count,offset,picked) {
                   11789:     if (count > 0) {
1.1065    raeburn  11790:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11791:         if (form.elements[item].type == 'radio') {
                   11792:             if (form.elements[item].value == 'dependency') {
                   11793:                 if (form.elements[item+1].type == 'select-one') {
                   11794:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11795:                         if (form.elements[item+1].options[i].value == picked) {
                   11796:                             form.elements[item+1].selectedIndex = i;
                   11797:                             break;
                   11798:                         }
                   11799:                     }
                   11800:                 }
                   11801:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11802:                     if (parents[count].length > 0) {
                   11803:                         for (var j=0; j<parents[count].length; j++) {
                   11804:                             containerSelect(form,parents[count][j],offset,picked);
                   11805:                         }
                   11806:                     }
                   11807:                 }
                   11808:             }
                   11809:         }
                   11810:     }
                   11811: }
                   11812: 
1.1059    raeburn  11813: function titleCheck(form,count,offset) {
                   11814:     if (count > 0) {
                   11815:         var chosen = (offset+$startcount)+7*(count-1);
                   11816:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11817:         var currtype = form.elements[depitem].type;
                   11818:         if (form.elements[chosen].value == 'display') {
                   11819:             document.getElementById('arc_title_'+count).style.display='block';
                   11820:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11821:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11822:             }
                   11823:         } else {
                   11824:             document.getElementById('arc_title_'+count).style.display='none';
                   11825:             if (currtype == 'text') { 
                   11826:                 document.getElementById('archive_title_'+count).value='';
                   11827:             }
                   11828:         }
                   11829:     }
                   11830:     return;
                   11831: }
                   11832: 
1.1055    raeburn  11833: // ]]>
                   11834: </script>
                   11835: END
                   11836:     return $scripttag;
                   11837: }
                   11838: 
                   11839: sub process_extracted_files {
1.1067    raeburn  11840:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11841:     my $numitems = $env{'form.archive_count'};
                   11842:     return unless ($numitems);
                   11843:     my @ids=&Apache::lonnet::current_machine_ids();
                   11844:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11845:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11846:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11847:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11848:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11849:         $pathtocheck = "$dir_root/$destination";
                   11850:         $dir = $dir_root;
                   11851:         $ishome = 1;
                   11852:     } else {
                   11853:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11854:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11855:         $dir = "$dir_root/$docudom/$docuname";    
                   11856:     }
                   11857:     my $currdir = "$dir_root/$destination";
                   11858:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11859:     if ($env{'form.folderpath'}) {
                   11860:         my @items = split('&',$env{'form.folderpath'});
                   11861:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  11862:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11863:             $containers{'0'}='page';
                   11864:         } else {
                   11865:             $containers{'0'}='sequence';
                   11866:         }
1.1055    raeburn  11867:     }
                   11868:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11869:     if ($numitems) {
                   11870:         for (my $i=1; $i<=$numitems; $i++) {
                   11871:             my $path = $env{'form.archive_content_'.$i};
                   11872:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11873:                 my $item = $1;
                   11874:                 $toplevelitems{$item} = $i;
                   11875:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11876:                     $is_dir{$item} = 1;
                   11877:                 }
                   11878:             }
                   11879:         }
                   11880:     }
1.1067    raeburn  11881:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11882:     if (keys(%toplevelitems) > 0) {
                   11883:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11884:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11885:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11886:     }
1.1066    raeburn  11887:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11888:     if ($numitems) {
                   11889:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  11890:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11891:             my $path = $env{'form.archive_content_'.$i};
                   11892:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11893:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11894:                     if ($prefix ne '' && $path ne '') {
                   11895:                         if (-e $prefix.$path) {
1.1066    raeburn  11896:                             if ((@archdirs > 0) && 
                   11897:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11898:                                 $todeletedir{$prefix.$path} = 1;
                   11899:                             } else {
                   11900:                                 $todelete{$prefix.$path} = 1;
                   11901:                             }
1.1055    raeburn  11902:                         }
                   11903:                     }
                   11904:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11905:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11906:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11907:                     $docstitle = $env{'form.archive_title_'.$i};
                   11908:                     if ($docstitle eq '') {
                   11909:                         $docstitle = $title;
                   11910:                     }
1.1055    raeburn  11911:                     $outer = 0;
1.1056    raeburn  11912:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11913:                         if (@{$dirorder{$i}} > 0) {
                   11914:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11915:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11916:                                     $outer = $item;
                   11917:                                     last;
                   11918:                                 }
                   11919:                             }
                   11920:                         }
                   11921:                     }
                   11922:                     my ($errtext,$fatal) = 
                   11923:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11924:                                                '/'.$folders{$outer}.'.'.
                   11925:                                                $containers{$outer});
                   11926:                     next if ($fatal);
                   11927:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11928:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11929:                             $mapinner{$i} = time;
1.1055    raeburn  11930:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11931:                             $containers{$i} = 'sequence';
                   11932:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11933:                                       $folders{$i}.'.'.$containers{$i};
                   11934:                             my $newidx = &LONCAPA::map::getresidx();
                   11935:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11936:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11937:                             push(@LONCAPA::map::order,$newidx);
                   11938:                             my ($outtext,$errtext) =
                   11939:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11940:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11941:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11942:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11943:                             unless ($errtext) {
                   11944:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11945:                             }
1.1055    raeburn  11946:                         }
                   11947:                     } else {
                   11948:                         if ($context eq 'coursedocs') {
                   11949:                             my $newidx=&LONCAPA::map::getresidx();
                   11950:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11951:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11952:                                       $title;
                   11953:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11954:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11955:                             }
                   11956:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11957:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   11958:                             }
                   11959:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   11960:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  11961:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  11962:                                 unless ($ishome) {
                   11963:                                     my $fetch = "$newdest{$i}/$title";
                   11964:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   11965:                                     $prompttofetch{$fetch} = 1;
                   11966:                                 }
1.1055    raeburn  11967:                             }
                   11968:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11969:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11970:                             push(@LONCAPA::map::order, $newidx);
                   11971:                             my ($outtext,$errtext)=
                   11972:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11973:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11974:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  11975:                             unless ($errtext) {
                   11976:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   11977:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   11978:                                 }
                   11979:                             }
1.1055    raeburn  11980:                         }
                   11981:                     }
1.1075.2.11  raeburn  11982:                 }
                   11983:             } else {
                   11984:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                   11985:             }
                   11986:         }
                   11987:         for (my $i=1; $i<=$numitems; $i++) {
                   11988:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   11989:             my $path = $env{'form.archive_content_'.$i};
                   11990:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11991:                 my ($title) = ($path =~ m{/([^/]+)$});
                   11992:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   11993:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   11994:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11995:                         my ($itemidx,$fullpath,$relpath);
                   11996:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   11997:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  11998:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  11999:                                 if ($dirorder{$i}->[$j] eq $container) {
                   12000:                                     $itemidx = $j;
1.1056    raeburn  12001:                                 }
                   12002:                             }
1.1075.2.11  raeburn  12003:                         }
                   12004:                         if ($itemidx eq '') {
                   12005:                             $itemidx =  0;
                   12006:                         }
                   12007:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12008:                             if ($mapinner{$referrer{$i}}) {
                   12009:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12010:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12011:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12012:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12013:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12014:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12015:                                             if (!-e $fullpath) {
                   12016:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12017:                                             }
                   12018:                                         }
1.1075.2.11  raeburn  12019:                                     } else {
                   12020:                                         last;
1.1056    raeburn  12021:                                     }
1.1075.2.11  raeburn  12022:                                 }
                   12023:                             }
                   12024:                         } elsif ($newdest{$referrer{$i}}) {
                   12025:                             $fullpath = $newdest{$referrer{$i}};
                   12026:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12027:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12028:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12029:                                     last;
                   12030:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12031:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12032:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12033:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12034:                                         if (!-e $fullpath) {
                   12035:                                             mkdir($fullpath,0755);
1.1056    raeburn  12036:                                         }
                   12037:                                     }
1.1075.2.11  raeburn  12038:                                 } else {
                   12039:                                     last;
1.1056    raeburn  12040:                                 }
1.1075.2.11  raeburn  12041:                             }
                   12042:                         }
                   12043:                         if ($fullpath ne '') {
                   12044:                             if (-e "$prefix$path") {
                   12045:                                 system("mv $prefix$path $fullpath/$title");
                   12046:                             }
                   12047:                             if (-e "$fullpath/$title") {
                   12048:                                 my $showpath;
                   12049:                                 if ($relpath ne '') {
                   12050:                                     $showpath = "$relpath/$title";
                   12051:                                 } else {
                   12052:                                     $showpath = "/$title";
1.1056    raeburn  12053:                                 }
1.1075.2.11  raeburn  12054:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   12055:                             }
                   12056:                             unless ($ishome) {
                   12057:                                 my $fetch = "$fullpath/$title";
                   12058:                                 $fetch =~ s/^\Q$prefix$dir\E//;
                   12059:                                 $prompttofetch{$fetch} = 1;
1.1055    raeburn  12060:                             }
                   12061:                         }
                   12062:                     }
1.1075.2.11  raeburn  12063:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12064:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   12065:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  12066:                 }
                   12067:             } else {
1.1075.2.11  raeburn  12068:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055    raeburn  12069:             }
                   12070:         }
                   12071:         if (keys(%todelete)) {
                   12072:             foreach my $key (keys(%todelete)) {
                   12073:                 unlink($key);
1.1066    raeburn  12074:             }
                   12075:         }
                   12076:         if (keys(%todeletedir)) {
                   12077:             foreach my $key (keys(%todeletedir)) {
                   12078:                 rmdir($key);
                   12079:             }
                   12080:         }
                   12081:         foreach my $dir (sort(keys(%is_dir))) {
                   12082:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12083:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12084:             }
                   12085:         }
1.1067    raeburn  12086:         if ($result ne '') {
                   12087:             $output .= '<ul>'."\n".
                   12088:                        $result."\n".
                   12089:                        '</ul>';
                   12090:         }
                   12091:         unless ($ishome) {
                   12092:             my $replicationfail;
                   12093:             foreach my $item (keys(%prompttofetch)) {
                   12094:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12095:                 unless ($fetchresult eq 'ok') {
                   12096:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12097:                 }
                   12098:             }
                   12099:             if ($replicationfail) {
                   12100:                 $output .= '<p class="LC_error">'.
                   12101:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12102:                            $replicationfail.
                   12103:                            '</ul></p>';
                   12104:             }
                   12105:         }
1.1055    raeburn  12106:     } else {
                   12107:         $warning = &mt('No items found in archive.');
                   12108:     }
                   12109:     if ($error) {
                   12110:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12111:                    $error.'</p>'."\n";
                   12112:     }
                   12113:     if ($warning) {
                   12114:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12115:     }
                   12116:     return $output;
                   12117: }
                   12118: 
1.1066    raeburn  12119: sub cleanup_empty_dirs {
                   12120:     my ($path) = @_;
                   12121:     if (($path ne '') && (-d $path)) {
                   12122:         if (opendir(my $dirh,$path)) {
                   12123:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12124:             my $numitems = 0;
                   12125:             foreach my $item (@dircontents) {
                   12126:                 if (-d "$path/$item") {
1.1075.2.28  raeburn  12127:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12128:                     if (-e "$path/$item") {
                   12129:                         $numitems ++;
                   12130:                     }
                   12131:                 } else {
                   12132:                     $numitems ++;
                   12133:                 }
                   12134:             }
                   12135:             if ($numitems == 0) {
                   12136:                 rmdir($path);
                   12137:             }
                   12138:             closedir($dirh);
                   12139:         }
                   12140:     }
                   12141:     return;
                   12142: }
                   12143: 
1.41      ng       12144: =pod
1.45      matthew  12145: 
1.1075.2.56  raeburn  12146: =item * &get_folder_hierarchy()
1.1068    raeburn  12147: 
                   12148: Provides hierarchy of names of folders/sub-folders containing the current
                   12149: item,
                   12150: 
                   12151: Inputs: 3
                   12152:      - $navmap - navmaps object
                   12153: 
                   12154:      - $map - url for map (either the trigger itself, or map containing
                   12155:                            the resource, which is the trigger).
                   12156: 
                   12157:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12158: 
                   12159: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12160: 
                   12161: =cut
                   12162: 
                   12163: sub get_folder_hierarchy {
                   12164:     my ($navmap,$map,$showitem) = @_;
                   12165:     my @pathitems;
                   12166:     if (ref($navmap)) {
                   12167:         my $mapres = $navmap->getResourceByUrl($map);
                   12168:         if (ref($mapres)) {
                   12169:             my $pcslist = $mapres->map_hierarchy();
                   12170:             if ($pcslist ne '') {
                   12171:                 my @pcs = split(/,/,$pcslist);
                   12172:                 foreach my $pc (@pcs) {
                   12173:                     if ($pc == 1) {
1.1075.2.38  raeburn  12174:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12175:                     } else {
                   12176:                         my $res = $navmap->getByMapPc($pc);
                   12177:                         if (ref($res)) {
                   12178:                             my $title = $res->compTitle();
                   12179:                             $title =~ s/\W+/_/g;
                   12180:                             if ($title ne '') {
                   12181:                                 push(@pathitems,$title);
                   12182:                             }
                   12183:                         }
                   12184:                     }
                   12185:                 }
                   12186:             }
1.1071    raeburn  12187:             if ($showitem) {
                   12188:                 if ($mapres->{ID} eq '0.0') {
1.1075.2.38  raeburn  12189:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12190:                 } else {
                   12191:                     my $maptitle = $mapres->compTitle();
                   12192:                     $maptitle =~ s/\W+/_/g;
                   12193:                     if ($maptitle ne '') {
                   12194:                         push(@pathitems,$maptitle);
                   12195:                     }
1.1068    raeburn  12196:                 }
                   12197:             }
                   12198:         }
                   12199:     }
                   12200:     return @pathitems;
                   12201: }
                   12202: 
                   12203: =pod
                   12204: 
1.1015    raeburn  12205: =item * &get_turnedin_filepath()
                   12206: 
                   12207: Determines path in a user's portfolio file for storage of files uploaded
                   12208: to a specific essayresponse or dropbox item.
                   12209: 
                   12210: Inputs: 3 required + 1 optional.
                   12211: $symb is symb for resource, $uname and $udom are for current user (required).
                   12212: $caller is optional (can be "submission", if routine is called when storing
                   12213: an upoaded file when "Submit Answer" button was pressed).
                   12214: 
                   12215: Returns array containing $path and $multiresp. 
                   12216: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12217: than one file upload item.  Callers of routine should append partid as a 
                   12218: subdirectory to $path in cases where $multiresp is 1.
                   12219: 
                   12220: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12221: 
                   12222: =cut
                   12223: 
                   12224: sub get_turnedin_filepath {
                   12225:     my ($symb,$uname,$udom,$caller) = @_;
                   12226:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12227:     my $turnindir;
                   12228:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12229:     $turnindir = $userhash{'turnindir'};
                   12230:     my ($path,$multiresp);
                   12231:     if ($turnindir eq '') {
                   12232:         if ($caller eq 'submission') {
                   12233:             $turnindir = &mt('turned in');
                   12234:             $turnindir =~ s/\W+/_/g;
                   12235:             my %newhash = (
                   12236:                             'turnindir' => $turnindir,
                   12237:                           );
                   12238:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12239:         }
                   12240:     }
                   12241:     if ($turnindir ne '') {
                   12242:         $path = '/'.$turnindir.'/';
                   12243:         my ($multipart,$turnin,@pathitems);
                   12244:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12245:         if (defined($navmap)) {
                   12246:             my $mapres = $navmap->getResourceByUrl($map);
                   12247:             if (ref($mapres)) {
                   12248:                 my $pcslist = $mapres->map_hierarchy();
                   12249:                 if ($pcslist ne '') {
                   12250:                     foreach my $pc (split(/,/,$pcslist)) {
                   12251:                         my $res = $navmap->getByMapPc($pc);
                   12252:                         if (ref($res)) {
                   12253:                             my $title = $res->compTitle();
                   12254:                             $title =~ s/\W+/_/g;
                   12255:                             if ($title ne '') {
1.1075.2.48  raeburn  12256:                                 if (($pc > 1) && (length($title) > 12)) {
                   12257:                                     $title = substr($title,0,12);
                   12258:                                 }
1.1015    raeburn  12259:                                 push(@pathitems,$title);
                   12260:                             }
                   12261:                         }
                   12262:                     }
                   12263:                 }
                   12264:                 my $maptitle = $mapres->compTitle();
                   12265:                 $maptitle =~ s/\W+/_/g;
                   12266:                 if ($maptitle ne '') {
1.1075.2.48  raeburn  12267:                     if (length($maptitle) > 12) {
                   12268:                         $maptitle = substr($maptitle,0,12);
                   12269:                     }
1.1015    raeburn  12270:                     push(@pathitems,$maptitle);
                   12271:                 }
                   12272:                 unless ($env{'request.state'} eq 'construct') {
                   12273:                     my $res = $navmap->getBySymb($symb);
                   12274:                     if (ref($res)) {
                   12275:                         my $partlist = $res->parts();
                   12276:                         my $totaluploads = 0;
                   12277:                         if (ref($partlist) eq 'ARRAY') {
                   12278:                             foreach my $part (@{$partlist}) {
                   12279:                                 my @types = $res->responseType($part);
                   12280:                                 my @ids = $res->responseIds($part);
                   12281:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12282:                                     if ($types[$i] eq 'essay') {
                   12283:                                         my $partid = $part.'_'.$ids[$i];
                   12284:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12285:                                             $totaluploads ++;
                   12286:                                         }
                   12287:                                     }
                   12288:                                 }
                   12289:                             }
                   12290:                             if ($totaluploads > 1) {
                   12291:                                 $multiresp = 1;
                   12292:                             }
                   12293:                         }
                   12294:                     }
                   12295:                 }
                   12296:             } else {
                   12297:                 return;
                   12298:             }
                   12299:         } else {
                   12300:             return;
                   12301:         }
                   12302:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12303:         $restitle =~ s/\W+/_/g;
                   12304:         if ($restitle eq '') {
                   12305:             $restitle = ($resurl =~ m{/[^/]+$});
                   12306:             if ($restitle eq '') {
                   12307:                 $restitle = time;
                   12308:             }
                   12309:         }
1.1075.2.48  raeburn  12310:         if (length($restitle) > 12) {
                   12311:             $restitle = substr($restitle,0,12);
                   12312:         }
1.1015    raeburn  12313:         push(@pathitems,$restitle);
                   12314:         $path .= join('/',@pathitems);
                   12315:     }
                   12316:     return ($path,$multiresp);
                   12317: }
                   12318: 
                   12319: =pod
                   12320: 
1.464     albertel 12321: =back
1.41      ng       12322: 
1.112     bowersj2 12323: =head1 CSV Upload/Handling functions
1.38      albertel 12324: 
1.41      ng       12325: =over 4
                   12326: 
1.648     raeburn  12327: =item * &upfile_store($r)
1.41      ng       12328: 
                   12329: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12330: needs $env{'form.upfile'}
1.41      ng       12331: returns $datatoken to be put into hidden field
                   12332: 
                   12333: =cut
1.31      albertel 12334: 
                   12335: sub upfile_store {
                   12336:     my $r=shift;
1.258     albertel 12337:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12338:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12339:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12340:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12341: 
1.258     albertel 12342:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12343: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12344:     {
1.158     raeburn  12345:         my $datafile = $r->dir_config('lonDaemons').
                   12346:                            '/tmp/'.$datatoken.'.tmp';
                   12347:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12348:             print $fh $env{'form.upfile'};
1.158     raeburn  12349:             close($fh);
                   12350:         }
1.31      albertel 12351:     }
                   12352:     return $datatoken;
                   12353: }
                   12354: 
1.56      matthew  12355: =pod
                   12356: 
1.648     raeburn  12357: =item * &load_tmp_file($r)
1.41      ng       12358: 
                   12359: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12360: needs $env{'form.datatoken'},
                   12361: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12362: 
                   12363: =cut
1.31      albertel 12364: 
                   12365: sub load_tmp_file {
                   12366:     my $r=shift;
                   12367:     my @studentdata=();
                   12368:     {
1.158     raeburn  12369:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12370:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12371:         if ( open(my $fh,"<$studentfile") ) {
                   12372:             @studentdata=<$fh>;
                   12373:             close($fh);
                   12374:         }
1.31      albertel 12375:     }
1.258     albertel 12376:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12377: }
                   12378: 
1.56      matthew  12379: =pod
                   12380: 
1.648     raeburn  12381: =item * &upfile_record_sep()
1.41      ng       12382: 
                   12383: Separate uploaded file into records
                   12384: returns array of records,
1.258     albertel 12385: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12386: 
                   12387: =cut
1.31      albertel 12388: 
                   12389: sub upfile_record_sep {
1.258     albertel 12390:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12391:     } else {
1.248     albertel 12392: 	my @records;
1.258     albertel 12393: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12394: 	    if ($line=~/^\s*$/) { next; }
                   12395: 	    push(@records,$line);
                   12396: 	}
                   12397: 	return @records;
1.31      albertel 12398:     }
                   12399: }
                   12400: 
1.56      matthew  12401: =pod
                   12402: 
1.648     raeburn  12403: =item * &record_sep($record)
1.41      ng       12404: 
1.258     albertel 12405: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12406: 
                   12407: =cut
                   12408: 
1.263     www      12409: sub takeleft {
                   12410:     my $index=shift;
                   12411:     return substr('0000'.$index,-4,4);
                   12412: }
                   12413: 
1.31      albertel 12414: sub record_sep {
                   12415:     my $record=shift;
                   12416:     my %components=();
1.258     albertel 12417:     if ($env{'form.upfiletype'} eq 'xml') {
                   12418:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12419:         my $i=0;
1.356     albertel 12420:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12421:             $field=~s/^(\"|\')//;
                   12422:             $field=~s/(\"|\')$//;
1.263     www      12423:             $components{&takeleft($i)}=$field;
1.31      albertel 12424:             $i++;
                   12425:         }
1.258     albertel 12426:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12427:         my $i=0;
1.356     albertel 12428:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12429:             $field=~s/^(\"|\')//;
                   12430:             $field=~s/(\"|\')$//;
1.263     www      12431:             $components{&takeleft($i)}=$field;
1.31      albertel 12432:             $i++;
                   12433:         }
                   12434:     } else {
1.561     www      12435:         my $separator=',';
1.480     banghart 12436:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12437:             $separator=';';
1.480     banghart 12438:         }
1.31      albertel 12439:         my $i=0;
1.561     www      12440: # the character we are looking for to indicate the end of a quote or a record 
                   12441:         my $looking_for=$separator;
                   12442: # do not add the characters to the fields
                   12443:         my $ignore=0;
                   12444: # we just encountered a separator (or the beginning of the record)
                   12445:         my $just_found_separator=1;
                   12446: # store the field we are working on here
                   12447:         my $field='';
                   12448: # work our way through all characters in record
                   12449:         foreach my $character ($record=~/(.)/g) {
                   12450:             if ($character eq $looking_for) {
                   12451:                if ($character ne $separator) {
                   12452: # Found the end of a quote, again looking for separator
                   12453:                   $looking_for=$separator;
                   12454:                   $ignore=1;
                   12455:                } else {
                   12456: # Found a separator, store away what we got
                   12457:                   $components{&takeleft($i)}=$field;
                   12458: 	          $i++;
                   12459:                   $just_found_separator=1;
                   12460:                   $ignore=0;
                   12461:                   $field='';
                   12462:                }
                   12463:                next;
                   12464:             }
                   12465: # single or double quotation marks after a separator indicate beginning of a quote
                   12466: # we are now looking for the end of the quote and need to ignore separators
                   12467:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12468:                $looking_for=$character;
                   12469:                next;
                   12470:             }
                   12471: # ignore would be true after we reached the end of a quote
                   12472:             if ($ignore) { next; }
                   12473:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   12474:             $field.=$character;
                   12475:             $just_found_separator=0; 
1.31      albertel 12476:         }
1.561     www      12477: # catch the very last entry, since we never encountered the separator
                   12478:         $components{&takeleft($i)}=$field;
1.31      albertel 12479:     }
                   12480:     return %components;
                   12481: }
                   12482: 
1.144     matthew  12483: ######################################################
                   12484: ######################################################
                   12485: 
1.56      matthew  12486: =pod
                   12487: 
1.648     raeburn  12488: =item * &upfile_select_html()
1.41      ng       12489: 
1.144     matthew  12490: Return HTML code to select a file from the users machine and specify 
                   12491: the file type.
1.41      ng       12492: 
                   12493: =cut
                   12494: 
1.144     matthew  12495: ######################################################
                   12496: ######################################################
1.31      albertel 12497: sub upfile_select_html {
1.144     matthew  12498:     my %Types = (
                   12499:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 12500:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  12501:                  space => &mt('Space separated'),
                   12502:                  tab   => &mt('Tabulator separated'),
                   12503: #                 xml   => &mt('HTML/XML'),
                   12504:                  );
                   12505:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  12506:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  12507:     foreach my $type (sort(keys(%Types))) {
                   12508:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   12509:     }
                   12510:     $Str .= "</select>\n";
                   12511:     return $Str;
1.31      albertel 12512: }
                   12513: 
1.301     albertel 12514: sub get_samples {
                   12515:     my ($records,$toget) = @_;
                   12516:     my @samples=({});
                   12517:     my $got=0;
                   12518:     foreach my $rec (@$records) {
                   12519: 	my %temp = &record_sep($rec);
                   12520: 	if (! grep(/\S/, values(%temp))) { next; }
                   12521: 	if (%temp) {
                   12522: 	    $samples[$got]=\%temp;
                   12523: 	    $got++;
                   12524: 	    if ($got == $toget) { last; }
                   12525: 	}
                   12526:     }
                   12527:     return \@samples;
                   12528: }
                   12529: 
1.144     matthew  12530: ######################################################
                   12531: ######################################################
                   12532: 
1.56      matthew  12533: =pod
                   12534: 
1.648     raeburn  12535: =item * &csv_print_samples($r,$records)
1.41      ng       12536: 
                   12537: Prints a table of sample values from each column uploaded $r is an
                   12538: Apache Request ref, $records is an arrayref from
                   12539: &Apache::loncommon::upfile_record_sep
                   12540: 
                   12541: =cut
                   12542: 
1.144     matthew  12543: ######################################################
                   12544: ######################################################
1.31      albertel 12545: sub csv_print_samples {
                   12546:     my ($r,$records) = @_;
1.662     bisitz   12547:     my $samples = &get_samples($records,5);
1.301     albertel 12548: 
1.594     raeburn  12549:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12550:               &start_data_table_header_row());
1.356     albertel 12551:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12552:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12553:     $r->print(&end_data_table_header_row());
1.301     albertel 12554:     foreach my $hash (@$samples) {
1.594     raeburn  12555: 	$r->print(&start_data_table_row());
1.356     albertel 12556: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12557: 	    $r->print('<td>');
1.356     albertel 12558: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12559: 	    $r->print('</td>');
                   12560: 	}
1.594     raeburn  12561: 	$r->print(&end_data_table_row());
1.31      albertel 12562:     }
1.594     raeburn  12563:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12564: }
                   12565: 
1.144     matthew  12566: ######################################################
                   12567: ######################################################
                   12568: 
1.56      matthew  12569: =pod
                   12570: 
1.648     raeburn  12571: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12572: 
                   12573: Prints a table to create associations between values and table columns.
1.144     matthew  12574: 
1.41      ng       12575: $r is an Apache Request ref,
                   12576: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12577: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12578: 
                   12579: =cut
                   12580: 
1.144     matthew  12581: ######################################################
                   12582: ######################################################
1.31      albertel 12583: sub csv_print_select_table {
                   12584:     my ($r,$records,$d) = @_;
1.301     albertel 12585:     my $i=0;
                   12586:     my $samples = &get_samples($records,1);
1.144     matthew  12587:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12588: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12589:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12590:               '<th>'.&mt('Column').'</th>'.
                   12591:               &end_data_table_header_row()."\n");
1.356     albertel 12592:     foreach my $array_ref (@$d) {
                   12593: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12594: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12595: 
1.875     bisitz   12596: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12597: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12598: 	$r->print('<option value="none"></option>');
1.356     albertel 12599: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12600: 	    $r->print('<option value="'.$sample.'"'.
                   12601:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12602:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12603: 	}
1.594     raeburn  12604: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12605: 	$i++;
                   12606:     }
1.594     raeburn  12607:     $r->print(&end_data_table());
1.31      albertel 12608:     $i--;
                   12609:     return $i;
                   12610: }
1.56      matthew  12611: 
1.144     matthew  12612: ######################################################
                   12613: ######################################################
                   12614: 
1.56      matthew  12615: =pod
1.31      albertel 12616: 
1.648     raeburn  12617: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12618: 
                   12619: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12620: 
                   12621: $r is an Apache Request ref,
                   12622: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12623: $d is an array of 2 element arrays (internal name, displayed name)
                   12624: 
                   12625: =cut
                   12626: 
1.144     matthew  12627: ######################################################
                   12628: ######################################################
1.31      albertel 12629: sub csv_samples_select_table {
                   12630:     my ($r,$records,$d) = @_;
                   12631:     my $i=0;
1.144     matthew  12632:     #
1.662     bisitz   12633:     my $max_samples = 5;
                   12634:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12635:     $r->print(&start_data_table().
                   12636:               &start_data_table_header_row().'<th>'.
                   12637:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12638:               &end_data_table_header_row());
1.301     albertel 12639: 
                   12640:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12641: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12642: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12643: 	foreach my $option (@$d) {
                   12644: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12645: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12646:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12647:                       $display.'</option>');
1.31      albertel 12648: 	}
                   12649: 	$r->print('</select></td><td>');
1.662     bisitz   12650: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12651: 	    if (defined($samples->[$line]{$key})) { 
                   12652: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12653: 	    }
                   12654: 	}
1.594     raeburn  12655: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12656: 	$i++;
                   12657:     }
1.594     raeburn  12658:     $r->print(&end_data_table());
1.31      albertel 12659:     $i--;
                   12660:     return($i);
1.115     matthew  12661: }
                   12662: 
1.144     matthew  12663: ######################################################
                   12664: ######################################################
                   12665: 
1.115     matthew  12666: =pod
                   12667: 
1.648     raeburn  12668: =item * &clean_excel_name($name)
1.115     matthew  12669: 
                   12670: Returns a replacement for $name which does not contain any illegal characters.
                   12671: 
                   12672: =cut
                   12673: 
1.144     matthew  12674: ######################################################
                   12675: ######################################################
1.115     matthew  12676: sub clean_excel_name {
                   12677:     my ($name) = @_;
                   12678:     $name =~ s/[:\*\?\/\\]//g;
                   12679:     if (length($name) > 31) {
                   12680:         $name = substr($name,0,31);
                   12681:     }
                   12682:     return $name;
1.25      albertel 12683: }
1.84      albertel 12684: 
1.85      albertel 12685: =pod
                   12686: 
1.648     raeburn  12687: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12688: 
                   12689: Returns either 1 or undef
                   12690: 
                   12691: 1 if the part is to be hidden, undef if it is to be shown
                   12692: 
                   12693: Arguments are:
                   12694: 
                   12695: $id the id of the part to be checked
                   12696: $symb, optional the symb of the resource to check
                   12697: $udom, optional the domain of the user to check for
                   12698: $uname, optional the username of the user to check for
                   12699: 
                   12700: =cut
1.84      albertel 12701: 
                   12702: sub check_if_partid_hidden {
                   12703:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12704:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12705: 					 $symb,$udom,$uname);
1.141     albertel 12706:     my $truth=1;
                   12707:     #if the string starts with !, then the list is the list to show not hide
                   12708:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12709:     my @hiddenlist=split(/,/,$hiddenparts);
                   12710:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12711: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12712:     }
1.141     albertel 12713:     return !$truth;
1.84      albertel 12714: }
1.127     matthew  12715: 
1.138     matthew  12716: 
                   12717: ############################################################
                   12718: ############################################################
                   12719: 
                   12720: =pod
                   12721: 
1.157     matthew  12722: =back 
                   12723: 
1.138     matthew  12724: =head1 cgi-bin script and graphing routines
                   12725: 
1.157     matthew  12726: =over 4
                   12727: 
1.648     raeburn  12728: =item * &get_cgi_id()
1.138     matthew  12729: 
                   12730: Inputs: none
                   12731: 
                   12732: Returns an id which can be used to pass environment variables
                   12733: to various cgi-bin scripts.  These environment variables will
                   12734: be removed from the users environment after a given time by
                   12735: the routine &Apache::lonnet::transfer_profile_to_env.
                   12736: 
                   12737: =cut
                   12738: 
                   12739: ############################################################
                   12740: ############################################################
1.152     albertel 12741: my $uniq=0;
1.136     matthew  12742: sub get_cgi_id {
1.154     albertel 12743:     $uniq=($uniq+1)%100000;
1.280     albertel 12744:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12745: }
                   12746: 
1.127     matthew  12747: ############################################################
                   12748: ############################################################
                   12749: 
                   12750: =pod
                   12751: 
1.648     raeburn  12752: =item * &DrawBarGraph()
1.127     matthew  12753: 
1.138     matthew  12754: Facilitates the plotting of data in a (stacked) bar graph.
                   12755: Puts plot definition data into the users environment in order for 
                   12756: graph.png to plot it.  Returns an <img> tag for the plot.
                   12757: The bars on the plot are labeled '1','2',...,'n'.
                   12758: 
                   12759: Inputs:
                   12760: 
                   12761: =over 4
                   12762: 
                   12763: =item $Title: string, the title of the plot
                   12764: 
                   12765: =item $xlabel: string, text describing the X-axis of the plot
                   12766: 
                   12767: =item $ylabel: string, text describing the Y-axis of the plot
                   12768: 
                   12769: =item $Max: scalar, the maximum Y value to use in the plot
                   12770: If $Max is < any data point, the graph will not be rendered.
                   12771: 
1.140     matthew  12772: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12773: they are plotted.  If undefined, default values will be used.
                   12774: 
1.178     matthew  12775: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12776: 
1.138     matthew  12777: =item @Values: An array of array references.  Each array reference holds data
                   12778: to be plotted in a stacked bar chart.
                   12779: 
1.239     matthew  12780: =item If the final element of @Values is a hash reference the key/value
                   12781: pairs will be added to the graph definition.
                   12782: 
1.138     matthew  12783: =back
                   12784: 
                   12785: Returns:
                   12786: 
                   12787: An <img> tag which references graph.png and the appropriate identifying
                   12788: information for the plot.
                   12789: 
1.127     matthew  12790: =cut
                   12791: 
                   12792: ############################################################
                   12793: ############################################################
1.134     matthew  12794: sub DrawBarGraph {
1.178     matthew  12795:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12796:     #
                   12797:     if (! defined($colors)) {
                   12798:         $colors = ['#33ff00', 
                   12799:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12800:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12801:                   ]; 
                   12802:     }
1.228     matthew  12803:     my $extra_settings = {};
                   12804:     if (ref($Values[-1]) eq 'HASH') {
                   12805:         $extra_settings = pop(@Values);
                   12806:     }
1.127     matthew  12807:     #
1.136     matthew  12808:     my $identifier = &get_cgi_id();
                   12809:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12810:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12811:         return '';
                   12812:     }
1.225     matthew  12813:     #
                   12814:     my @Labels;
                   12815:     if (defined($labels)) {
                   12816:         @Labels = @$labels;
                   12817:     } else {
                   12818:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12819:             push (@Labels,$i+1);
                   12820:         }
                   12821:     }
                   12822:     #
1.129     matthew  12823:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12824:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12825:     my %ValuesHash;
                   12826:     my $NumSets=1;
                   12827:     foreach my $array (@Values) {
                   12828:         next if (! ref($array));
1.136     matthew  12829:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12830:             join(',',@$array);
1.129     matthew  12831:     }
1.127     matthew  12832:     #
1.136     matthew  12833:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12834:     if ($NumBars < 3) {
                   12835:         $width = 120+$NumBars*32;
1.220     matthew  12836:         $xskip = 1;
1.225     matthew  12837:         $bar_width = 30;
                   12838:     } elsif ($NumBars < 5) {
                   12839:         $width = 120+$NumBars*20;
                   12840:         $xskip = 1;
                   12841:         $bar_width = 20;
1.220     matthew  12842:     } elsif ($NumBars < 10) {
1.136     matthew  12843:         $width = 120+$NumBars*15;
                   12844:         $xskip = 1;
                   12845:         $bar_width = 15;
                   12846:     } elsif ($NumBars <= 25) {
                   12847:         $width = 120+$NumBars*11;
                   12848:         $xskip = 5;
                   12849:         $bar_width = 8;
                   12850:     } elsif ($NumBars <= 50) {
                   12851:         $width = 120+$NumBars*8;
                   12852:         $xskip = 5;
                   12853:         $bar_width = 4;
                   12854:     } else {
                   12855:         $width = 120+$NumBars*8;
                   12856:         $xskip = 5;
                   12857:         $bar_width = 4;
                   12858:     }
                   12859:     #
1.137     matthew  12860:     $Max = 1 if ($Max < 1);
                   12861:     if ( int($Max) < $Max ) {
                   12862:         $Max++;
                   12863:         $Max = int($Max);
                   12864:     }
1.127     matthew  12865:     $Title  = '' if (! defined($Title));
                   12866:     $xlabel = '' if (! defined($xlabel));
                   12867:     $ylabel = '' if (! defined($ylabel));
1.369     www      12868:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12869:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12870:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12871:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12872:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12873:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12874:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12875:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12876:     $ValuesHash{$id.'.height'}   = $height;
                   12877:     $ValuesHash{$id.'.width'}    = $width;
                   12878:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12879:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12880:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12881:     #
1.228     matthew  12882:     # Deal with other parameters
                   12883:     while (my ($key,$value) = each(%$extra_settings)) {
                   12884:         $ValuesHash{$id.'.'.$key} = $value;
                   12885:     }
                   12886:     #
1.646     raeburn  12887:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12888:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12889: }
                   12890: 
                   12891: ############################################################
                   12892: ############################################################
                   12893: 
                   12894: =pod
                   12895: 
1.648     raeburn  12896: =item * &DrawXYGraph()
1.137     matthew  12897: 
1.138     matthew  12898: Facilitates the plotting of data in an XY graph.
                   12899: Puts plot definition data into the users environment in order for 
                   12900: graph.png to plot it.  Returns an <img> tag for the plot.
                   12901: 
                   12902: Inputs:
                   12903: 
                   12904: =over 4
                   12905: 
                   12906: =item $Title: string, the title of the plot
                   12907: 
                   12908: =item $xlabel: string, text describing the X-axis of the plot
                   12909: 
                   12910: =item $ylabel: string, text describing the Y-axis of the plot
                   12911: 
                   12912: =item $Max: scalar, the maximum Y value to use in the plot
                   12913: If $Max is < any data point, the graph will not be rendered.
                   12914: 
                   12915: =item $colors: Array ref containing the hex color codes for the data to be 
                   12916: plotted in.  If undefined, default values will be used.
                   12917: 
                   12918: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12919: 
                   12920: =item $Ydata: Array ref containing Array refs.  
1.185     www      12921: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12922: 
                   12923: =item %Values: hash indicating or overriding any default values which are 
                   12924: passed to graph.png.  
                   12925: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12926: 
                   12927: =back
                   12928: 
                   12929: Returns:
                   12930: 
                   12931: An <img> tag which references graph.png and the appropriate identifying
                   12932: information for the plot.
                   12933: 
1.137     matthew  12934: =cut
                   12935: 
                   12936: ############################################################
                   12937: ############################################################
                   12938: sub DrawXYGraph {
                   12939:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12940:     #
                   12941:     # Create the identifier for the graph
                   12942:     my $identifier = &get_cgi_id();
                   12943:     my $id = 'cgi.'.$identifier;
                   12944:     #
                   12945:     $Title  = '' if (! defined($Title));
                   12946:     $xlabel = '' if (! defined($xlabel));
                   12947:     $ylabel = '' if (! defined($ylabel));
                   12948:     my %ValuesHash = 
                   12949:         (
1.369     www      12950:          $id.'.title'  => &escape($Title),
                   12951:          $id.'.xlabel' => &escape($xlabel),
                   12952:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12953:          $id.'.y_max_value'=> $Max,
                   12954:          $id.'.labels'     => join(',',@$Xlabels),
                   12955:          $id.'.PlotType'   => 'XY',
                   12956:          );
                   12957:     #
                   12958:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   12959:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12960:     }
                   12961:     #
                   12962:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   12963:         return '';
                   12964:     }
                   12965:     my $NumSets=1;
1.138     matthew  12966:     foreach my $array (@{$Ydata}){
1.137     matthew  12967:         next if (! ref($array));
                   12968:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   12969:     }
1.138     matthew  12970:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  12971:     #
                   12972:     # Deal with other parameters
                   12973:     while (my ($key,$value) = each(%Values)) {
                   12974:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  12975:     }
                   12976:     #
1.646     raeburn  12977:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  12978:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12979: }
                   12980: 
                   12981: ############################################################
                   12982: ############################################################
                   12983: 
                   12984: =pod
                   12985: 
1.648     raeburn  12986: =item * &DrawXYYGraph()
1.138     matthew  12987: 
                   12988: Facilitates the plotting of data in an XY graph with two Y axes.
                   12989: Puts plot definition data into the users environment in order for 
                   12990: graph.png to plot it.  Returns an <img> tag for the plot.
                   12991: 
                   12992: Inputs:
                   12993: 
                   12994: =over 4
                   12995: 
                   12996: =item $Title: string, the title of the plot
                   12997: 
                   12998: =item $xlabel: string, text describing the X-axis of the plot
                   12999: 
                   13000: =item $ylabel: string, text describing the Y-axis of the plot
                   13001: 
                   13002: =item $colors: Array ref containing the hex color codes for the data to be 
                   13003: plotted in.  If undefined, default values will be used.
                   13004: 
                   13005: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13006: 
                   13007: =item $Ydata1: The first data set
                   13008: 
                   13009: =item $Min1: The minimum value of the left Y-axis
                   13010: 
                   13011: =item $Max1: The maximum value of the left Y-axis
                   13012: 
                   13013: =item $Ydata2: The second data set
                   13014: 
                   13015: =item $Min2: The minimum value of the right Y-axis
                   13016: 
                   13017: =item $Max2: The maximum value of the left Y-axis
                   13018: 
                   13019: =item %Values: hash indicating or overriding any default values which are 
                   13020: passed to graph.png.  
                   13021: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13022: 
                   13023: =back
                   13024: 
                   13025: Returns:
                   13026: 
                   13027: An <img> tag which references graph.png and the appropriate identifying
                   13028: information for the plot.
1.136     matthew  13029: 
                   13030: =cut
                   13031: 
                   13032: ############################################################
                   13033: ############################################################
1.137     matthew  13034: sub DrawXYYGraph {
                   13035:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13036:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13037:     #
                   13038:     # Create the identifier for the graph
                   13039:     my $identifier = &get_cgi_id();
                   13040:     my $id = 'cgi.'.$identifier;
                   13041:     #
                   13042:     $Title  = '' if (! defined($Title));
                   13043:     $xlabel = '' if (! defined($xlabel));
                   13044:     $ylabel = '' if (! defined($ylabel));
                   13045:     my %ValuesHash = 
                   13046:         (
1.369     www      13047:          $id.'.title'  => &escape($Title),
                   13048:          $id.'.xlabel' => &escape($xlabel),
                   13049:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13050:          $id.'.labels' => join(',',@$Xlabels),
                   13051:          $id.'.PlotType' => 'XY',
                   13052:          $id.'.NumSets' => 2,
1.137     matthew  13053:          $id.'.two_axes' => 1,
                   13054:          $id.'.y1_max_value' => $Max1,
                   13055:          $id.'.y1_min_value' => $Min1,
                   13056:          $id.'.y2_max_value' => $Max2,
                   13057:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13058:          );
                   13059:     #
1.137     matthew  13060:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13061:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13062:     }
                   13063:     #
                   13064:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13065:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13066:         return '';
                   13067:     }
                   13068:     my $NumSets=1;
1.137     matthew  13069:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13070:         next if (! ref($array));
                   13071:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13072:     }
                   13073:     #
                   13074:     # Deal with other parameters
                   13075:     while (my ($key,$value) = each(%Values)) {
                   13076:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13077:     }
                   13078:     #
1.646     raeburn  13079:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13080:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13081: }
                   13082: 
                   13083: ############################################################
                   13084: ############################################################
                   13085: 
                   13086: =pod
                   13087: 
1.157     matthew  13088: =back 
                   13089: 
1.139     matthew  13090: =head1 Statistics helper routines?  
                   13091: 
                   13092: Bad place for them but what the hell.
                   13093: 
1.157     matthew  13094: =over 4
                   13095: 
1.648     raeburn  13096: =item * &chartlink()
1.139     matthew  13097: 
                   13098: Returns a link to the chart for a specific student.  
                   13099: 
                   13100: Inputs:
                   13101: 
                   13102: =over 4
                   13103: 
                   13104: =item $linktext: The text of the link
                   13105: 
                   13106: =item $sname: The students username
                   13107: 
                   13108: =item $sdomain: The students domain
                   13109: 
                   13110: =back
                   13111: 
1.157     matthew  13112: =back
                   13113: 
1.139     matthew  13114: =cut
                   13115: 
                   13116: ############################################################
                   13117: ############################################################
                   13118: sub chartlink {
                   13119:     my ($linktext, $sname, $sdomain) = @_;
                   13120:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13121:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13122:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13123:        '">'.$linktext.'</a>';
1.153     matthew  13124: }
                   13125: 
                   13126: #######################################################
                   13127: #######################################################
                   13128: 
                   13129: =pod
                   13130: 
                   13131: =head1 Course Environment Routines
1.157     matthew  13132: 
                   13133: =over 4
1.153     matthew  13134: 
1.648     raeburn  13135: =item * &restore_course_settings()
1.153     matthew  13136: 
1.648     raeburn  13137: =item * &store_course_settings()
1.153     matthew  13138: 
                   13139: Restores/Store indicated form parameters from the course environment.
                   13140: Will not overwrite existing values of the form parameters.
                   13141: 
                   13142: Inputs: 
                   13143: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13144: 
                   13145: a hash ref describing the data to be stored.  For example:
                   13146:    
                   13147: %Save_Parameters = ('Status' => 'scalar',
                   13148:     'chartoutputmode' => 'scalar',
                   13149:     'chartoutputdata' => 'scalar',
                   13150:     'Section' => 'array',
1.373     raeburn  13151:     'Group' => 'array',
1.153     matthew  13152:     'StudentData' => 'array',
                   13153:     'Maps' => 'array');
                   13154: 
                   13155: Returns: both routines return nothing
                   13156: 
1.631     raeburn  13157: =back
                   13158: 
1.153     matthew  13159: =cut
                   13160: 
                   13161: #######################################################
                   13162: #######################################################
                   13163: sub store_course_settings {
1.496     albertel 13164:     return &store_settings($env{'request.course.id'},@_);
                   13165: }
                   13166: 
                   13167: sub store_settings {
1.153     matthew  13168:     # save to the environment
                   13169:     # appenv the same items, just to be safe
1.300     albertel 13170:     my $udom  = $env{'user.domain'};
                   13171:     my $uname = $env{'user.name'};
1.496     albertel 13172:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13173:     my %SaveHash;
                   13174:     my %AppHash;
                   13175:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13176:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13177:         my $envname = 'environment.'.$basename;
1.258     albertel 13178:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13179:             # Save this value away
                   13180:             if ($type eq 'scalar' &&
1.258     albertel 13181:                 (! exists($env{$envname}) || 
                   13182:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13183:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13184:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13185:             } elsif ($type eq 'array') {
                   13186:                 my $stored_form;
1.258     albertel 13187:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13188:                     $stored_form = join(',',
                   13189:                                         map {
1.369     www      13190:                                             &escape($_);
1.258     albertel 13191:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13192:                 } else {
                   13193:                     $stored_form = 
1.369     www      13194:                         &escape($env{'form.'.$setting});
1.153     matthew  13195:                 }
                   13196:                 # Determine if the array contents are the same.
1.258     albertel 13197:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13198:                     $SaveHash{$basename} = $stored_form;
                   13199:                     $AppHash{$envname}   = $stored_form;
                   13200:                 }
                   13201:             }
                   13202:         }
                   13203:     }
                   13204:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13205:                                           $udom,$uname);
1.153     matthew  13206:     if ($put_result !~ /^(ok|delayed)/) {
                   13207:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13208:                                  'got error:'.$put_result);
                   13209:     }
                   13210:     # Make sure these settings stick around in this session, too
1.646     raeburn  13211:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13212:     return;
                   13213: }
                   13214: 
                   13215: sub restore_course_settings {
1.499     albertel 13216:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13217: }
                   13218: 
                   13219: sub restore_settings {
                   13220:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13221:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13222:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13223:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13224:             '.'.$setting;
1.258     albertel 13225:         if (exists($env{$envname})) {
1.153     matthew  13226:             if ($type eq 'scalar') {
1.258     albertel 13227:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13228:             } elsif ($type eq 'array') {
1.258     albertel 13229:                 $env{'form.'.$setting} = [ 
1.153     matthew  13230:                                            map { 
1.369     www      13231:                                                &unescape($_); 
1.258     albertel 13232:                                            } split(',',$env{$envname})
1.153     matthew  13233:                                            ];
                   13234:             }
                   13235:         }
                   13236:     }
1.127     matthew  13237: }
                   13238: 
1.618     raeburn  13239: #######################################################
                   13240: #######################################################
                   13241: 
                   13242: =pod
                   13243: 
                   13244: =head1 Domain E-mail Routines  
                   13245: 
                   13246: =over 4
                   13247: 
1.648     raeburn  13248: =item * &build_recipient_list()
1.618     raeburn  13249: 
1.1075.2.44  raeburn  13250: Build recipient lists for following types of e-mail:
1.766     raeburn  13251: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44  raeburn  13252: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   13253: module change checking, student/employee ID conflict checks, as
                   13254: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   13255: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  13256: 
                   13257: Inputs:
1.1075.2.44  raeburn  13258: defmail (scalar - email address of default recipient),
                   13259: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   13260: requestsmail, updatesmail, or idconflictsmail).
                   13261: 
1.619     raeburn  13262: defdom (domain for which to retrieve configuration settings),
1.1075.2.44  raeburn  13263: 
                   13264: origmail (scalar - email address of recipient from loncapa.conf,
                   13265: i.e., predates configuration by DC via domainprefs.pm
1.618     raeburn  13266: 
1.655     raeburn  13267: Returns: comma separated list of addresses to which to send e-mail.
                   13268: 
                   13269: =back
1.618     raeburn  13270: 
                   13271: =cut
                   13272: 
                   13273: ############################################################
                   13274: ############################################################
                   13275: sub build_recipient_list {
1.619     raeburn  13276:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13277:     my @recipients;
                   13278:     my $otheremails;
                   13279:     my %domconfig =
                   13280:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13281:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13282:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13283:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13284:                 my @contacts = ('adminemail','supportemail');
                   13285:                 foreach my $item (@contacts) {
                   13286:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13287:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13288:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13289:                             push(@recipients,$addr);
                   13290:                         }
1.619     raeburn  13291:                     }
1.766     raeburn  13292:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13293:                 }
                   13294:             }
1.766     raeburn  13295:         } elsif ($origmail ne '') {
                   13296:             push(@recipients,$origmail);
1.618     raeburn  13297:         }
1.619     raeburn  13298:     } elsif ($origmail ne '') {
                   13299:         push(@recipients,$origmail);
1.618     raeburn  13300:     }
1.688     raeburn  13301:     if (defined($defmail)) {
                   13302:         if ($defmail ne '') {
                   13303:             push(@recipients,$defmail);
                   13304:         }
1.618     raeburn  13305:     }
                   13306:     if ($otheremails) {
1.619     raeburn  13307:         my @others;
                   13308:         if ($otheremails =~ /,/) {
                   13309:             @others = split(/,/,$otheremails);
1.618     raeburn  13310:         } else {
1.619     raeburn  13311:             push(@others,$otheremails);
                   13312:         }
                   13313:         foreach my $addr (@others) {
                   13314:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13315:                 push(@recipients,$addr);
                   13316:             }
1.618     raeburn  13317:         }
                   13318:     }
1.619     raeburn  13319:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13320:     return $recipientlist;
                   13321: }
                   13322: 
1.127     matthew  13323: ############################################################
                   13324: ############################################################
1.154     albertel 13325: 
1.655     raeburn  13326: =pod
                   13327: 
                   13328: =head1 Course Catalog Routines
                   13329: 
                   13330: =over 4
                   13331: 
                   13332: =item * &gather_categories()
                   13333: 
                   13334: Converts category definitions - keys of categories hash stored in  
                   13335: coursecategories in configuration.db on the primary library server in a 
                   13336: domain - to an array.  Also generates javascript and idx hash used to 
                   13337: generate Domain Coordinator interface for editing Course Categories.
                   13338: 
                   13339: Inputs:
1.663     raeburn  13340: 
1.655     raeburn  13341: categories (reference to hash of category definitions).
1.663     raeburn  13342: 
1.655     raeburn  13343: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13344:       categories and subcategories).
1.663     raeburn  13345: 
1.655     raeburn  13346: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13347:       editing Course Categories).
1.663     raeburn  13348: 
1.655     raeburn  13349: jsarray (reference to array of categories used to create Javascript arrays for
                   13350:          Domain Coordinator interface for editing Course Categories).
                   13351: 
                   13352: Returns: nothing
                   13353: 
                   13354: Side effects: populates cats, idx and jsarray. 
                   13355: 
                   13356: =cut
                   13357: 
                   13358: sub gather_categories {
                   13359:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13360:     my %counters;
                   13361:     my $num = 0;
                   13362:     foreach my $item (keys(%{$categories})) {
                   13363:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13364:         if ($container eq '' && $depth == 0) {
                   13365:             $cats->[$depth][$categories->{$item}] = $cat;
                   13366:         } else {
                   13367:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13368:         }
                   13369:         my ($escitem,$tail) = split(/:/,$item,2);
                   13370:         if ($counters{$tail} eq '') {
                   13371:             $counters{$tail} = $num;
                   13372:             $num ++;
                   13373:         }
                   13374:         if (ref($idx) eq 'HASH') {
                   13375:             $idx->{$item} = $counters{$tail};
                   13376:         }
                   13377:         if (ref($jsarray) eq 'ARRAY') {
                   13378:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13379:         }
                   13380:     }
                   13381:     return;
                   13382: }
                   13383: 
                   13384: =pod
                   13385: 
                   13386: =item * &extract_categories()
                   13387: 
                   13388: Used to generate breadcrumb trails for course categories.
                   13389: 
                   13390: Inputs:
1.663     raeburn  13391: 
1.655     raeburn  13392: categories (reference to hash of category definitions).
1.663     raeburn  13393: 
1.655     raeburn  13394: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13395:       categories and subcategories).
1.663     raeburn  13396: 
1.655     raeburn  13397: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  13398: 
1.655     raeburn  13399: allitems (reference to hash - key is category key 
                   13400:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13401: 
1.655     raeburn  13402: idx (reference to hash of counters used in Domain Coordinator interface for
                   13403:       editing Course Categories).
1.663     raeburn  13404: 
1.655     raeburn  13405: jsarray (reference to array of categories used to create Javascript arrays for
                   13406:          Domain Coordinator interface for editing Course Categories).
                   13407: 
1.665     raeburn  13408: subcats (reference to hash of arrays containing all subcategories within each 
                   13409:          category, -recursive)
                   13410: 
1.655     raeburn  13411: Returns: nothing
                   13412: 
                   13413: Side effects: populates trails and allitems hash references.
                   13414: 
                   13415: =cut
                   13416: 
                   13417: sub extract_categories {
1.665     raeburn  13418:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  13419:     if (ref($categories) eq 'HASH') {
                   13420:         &gather_categories($categories,$cats,$idx,$jsarray);
                   13421:         if (ref($cats->[0]) eq 'ARRAY') {
                   13422:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   13423:                 my $name = $cats->[0][$i];
                   13424:                 my $item = &escape($name).'::0';
                   13425:                 my $trailstr;
                   13426:                 if ($name eq 'instcode') {
                   13427:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  13428:                 } elsif ($name eq 'communities') {
                   13429:                     $trailstr = &mt('Communities');
1.655     raeburn  13430:                 } else {
                   13431:                     $trailstr = $name;
                   13432:                 }
                   13433:                 if ($allitems->{$item} eq '') {
                   13434:                     push(@{$trails},$trailstr);
                   13435:                     $allitems->{$item} = scalar(@{$trails})-1;
                   13436:                 }
                   13437:                 my @parents = ($name);
                   13438:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   13439:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   13440:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  13441:                         if (ref($subcats) eq 'HASH') {
                   13442:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   13443:                         }
                   13444:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   13445:                     }
                   13446:                 } else {
                   13447:                     if (ref($subcats) eq 'HASH') {
                   13448:                         $subcats->{$item} = [];
1.655     raeburn  13449:                     }
                   13450:                 }
                   13451:             }
                   13452:         }
                   13453:     }
                   13454:     return;
                   13455: }
                   13456: 
                   13457: =pod
                   13458: 
1.1075.2.56  raeburn  13459: =item * &recurse_categories()
1.655     raeburn  13460: 
                   13461: Recursively used to generate breadcrumb trails for course categories.
                   13462: 
                   13463: Inputs:
1.663     raeburn  13464: 
1.655     raeburn  13465: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13466:       categories and subcategories).
1.663     raeburn  13467: 
1.655     raeburn  13468: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  13469: 
                   13470: category (current course category, for which breadcrumb trail is being generated).
                   13471: 
                   13472: trails (reference to array of breadcrumb trails for each category).
                   13473: 
1.655     raeburn  13474: allitems (reference to hash - key is category key
                   13475:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13476: 
1.655     raeburn  13477: parents (array containing containers directories for current category, 
                   13478:          back to top level). 
                   13479: 
                   13480: Returns: nothing
                   13481: 
                   13482: Side effects: populates trails and allitems hash references
                   13483: 
                   13484: =cut
                   13485: 
                   13486: sub recurse_categories {
1.665     raeburn  13487:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  13488:     my $shallower = $depth - 1;
                   13489:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   13490:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   13491:             my $name = $cats->[$depth]{$category}[$k];
                   13492:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13493:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13494:             if ($allitems->{$item} eq '') {
                   13495:                 push(@{$trails},$trailstr);
                   13496:                 $allitems->{$item} = scalar(@{$trails})-1;
                   13497:             }
                   13498:             my $deeper = $depth+1;
                   13499:             push(@{$parents},$category);
1.665     raeburn  13500:             if (ref($subcats) eq 'HASH') {
                   13501:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   13502:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   13503:                     my $higher;
                   13504:                     if ($j > 0) {
                   13505:                         $higher = &escape($parents->[$j]).':'.
                   13506:                                   &escape($parents->[$j-1]).':'.$j;
                   13507:                     } else {
                   13508:                         $higher = &escape($parents->[$j]).'::'.$j;
                   13509:                     }
                   13510:                     push(@{$subcats->{$higher}},$subcat);
                   13511:                 }
                   13512:             }
                   13513:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   13514:                                 $subcats);
1.655     raeburn  13515:             pop(@{$parents});
                   13516:         }
                   13517:     } else {
                   13518:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13519:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13520:         if ($allitems->{$item} eq '') {
                   13521:             push(@{$trails},$trailstr);
                   13522:             $allitems->{$item} = scalar(@{$trails})-1;
                   13523:         }
                   13524:     }
                   13525:     return;
                   13526: }
                   13527: 
1.663     raeburn  13528: =pod
                   13529: 
1.1075.2.56  raeburn  13530: =item * &assign_categories_table()
1.663     raeburn  13531: 
                   13532: Create a datatable for display of hierarchical categories in a domain,
                   13533: with checkboxes to allow a course to be categorized. 
                   13534: 
                   13535: Inputs:
                   13536: 
                   13537: cathash - reference to hash of categories defined for the domain (from
                   13538:           configuration.db)
                   13539: 
                   13540: currcat - scalar with an & separated list of categories assigned to a course. 
                   13541: 
1.919     raeburn  13542: type    - scalar contains course type (Course or Community).
                   13543: 
1.663     raeburn  13544: Returns: $output (markup to be displayed) 
                   13545: 
                   13546: =cut
                   13547: 
                   13548: sub assign_categories_table {
1.919     raeburn  13549:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13550:     my $output;
                   13551:     if (ref($cathash) eq 'HASH') {
                   13552:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13553:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13554:         $maxdepth = scalar(@cats);
                   13555:         if (@cats > 0) {
                   13556:             my $itemcount = 0;
                   13557:             if (ref($cats[0]) eq 'ARRAY') {
                   13558:                 my @currcategories;
                   13559:                 if ($currcat ne '') {
                   13560:                     @currcategories = split('&',$currcat);
                   13561:                 }
1.919     raeburn  13562:                 my $table;
1.663     raeburn  13563:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13564:                     my $parent = $cats[0][$i];
1.919     raeburn  13565:                     next if ($parent eq 'instcode');
                   13566:                     if ($type eq 'Community') {
                   13567:                         next unless ($parent eq 'communities');
                   13568:                     } else {
                   13569:                         next if ($parent eq 'communities');
                   13570:                     }
1.663     raeburn  13571:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13572:                     my $item = &escape($parent).'::0';
                   13573:                     my $checked = '';
                   13574:                     if (@currcategories > 0) {
                   13575:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13576:                             $checked = ' checked="checked"';
1.663     raeburn  13577:                         }
                   13578:                     }
1.919     raeburn  13579:                     my $parent_title = $parent;
                   13580:                     if ($parent eq 'communities') {
                   13581:                         $parent_title = &mt('Communities');
                   13582:                     }
                   13583:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13584:                               '<input type="checkbox" name="usecategory" value="'.
                   13585:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13586:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13587:                     my $depth = 1;
                   13588:                     push(@path,$parent);
1.919     raeburn  13589:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13590:                     pop(@path);
1.919     raeburn  13591:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13592:                     $itemcount ++;
                   13593:                 }
1.919     raeburn  13594:                 if ($itemcount) {
                   13595:                     $output = &Apache::loncommon::start_data_table().
                   13596:                               $table.
                   13597:                               &Apache::loncommon::end_data_table();
                   13598:                 }
1.663     raeburn  13599:             }
                   13600:         }
                   13601:     }
                   13602:     return $output;
                   13603: }
                   13604: 
                   13605: =pod
                   13606: 
1.1075.2.56  raeburn  13607: =item * &assign_category_rows()
1.663     raeburn  13608: 
                   13609: Create a datatable row for display of nested categories in a domain,
                   13610: with checkboxes to allow a course to be categorized,called recursively.
                   13611: 
                   13612: Inputs:
                   13613: 
                   13614: itemcount - track row number for alternating colors
                   13615: 
                   13616: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13617:       categories and subcategories.
                   13618: 
                   13619: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13620: 
                   13621: parent - parent of current category item
                   13622: 
                   13623: path - Array containing all categories back up through the hierarchy from the
                   13624:        current category to the top level.
                   13625: 
                   13626: currcategories - reference to array of current categories assigned to the course
                   13627: 
                   13628: Returns: $output (markup to be displayed).
                   13629: 
                   13630: =cut
                   13631: 
                   13632: sub assign_category_rows {
                   13633:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13634:     my ($text,$name,$item,$chgstr);
                   13635:     if (ref($cats) eq 'ARRAY') {
                   13636:         my $maxdepth = scalar(@{$cats});
                   13637:         if (ref($cats->[$depth]) eq 'HASH') {
                   13638:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13639:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13640:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45  raeburn  13641:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  13642:                 for (my $j=0; $j<$numchildren; $j++) {
                   13643:                     $name = $cats->[$depth]{$parent}[$j];
                   13644:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13645:                     my $deeper = $depth+1;
                   13646:                     my $checked = '';
                   13647:                     if (ref($currcategories) eq 'ARRAY') {
                   13648:                         if (@{$currcategories} > 0) {
                   13649:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13650:                                 $checked = ' checked="checked"';
1.663     raeburn  13651:                             }
                   13652:                         }
                   13653:                     }
1.664     raeburn  13654:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13655:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13656:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13657:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13658:                              '</td><td>';
1.663     raeburn  13659:                     if (ref($path) eq 'ARRAY') {
                   13660:                         push(@{$path},$name);
                   13661:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13662:                         pop(@{$path});
                   13663:                     }
                   13664:                     $text .= '</td></tr>';
                   13665:                 }
                   13666:                 $text .= '</table></td>';
                   13667:             }
                   13668:         }
                   13669:     }
                   13670:     return $text;
                   13671: }
                   13672: 
1.1075.2.69  raeburn  13673: =pod
                   13674: 
                   13675: =back
                   13676: 
                   13677: =cut
                   13678: 
1.655     raeburn  13679: ############################################################
                   13680: ############################################################
                   13681: 
                   13682: 
1.443     albertel 13683: sub commit_customrole {
1.664     raeburn  13684:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13685:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13686:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13687:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13688:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13689:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13690:                  '</b><br />';
                   13691:     return $output;
                   13692: }
                   13693: 
                   13694: sub commit_standardrole {
1.1075.2.31  raeburn  13695:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  13696:     my ($output,$logmsg,$linefeed);
                   13697:     if ($context eq 'auto') {
                   13698:         $linefeed = "\n";
                   13699:     } else {
                   13700:         $linefeed = "<br />\n";
                   13701:     }  
1.443     albertel 13702:     if ($three eq 'st') {
1.541     raeburn  13703:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31  raeburn  13704:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  13705:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13706:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13707:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13708:         } else {
1.541     raeburn  13709:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13710:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13711:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13712:             if ($context eq 'auto') {
                   13713:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13714:             } else {
                   13715:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13716:                &mt('Add to classlist').': <b>ok</b>';
                   13717:             }
                   13718:             $output .= $linefeed;
1.443     albertel 13719:         }
                   13720:     } else {
                   13721:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13722:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13723:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13724:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13725:         if ($context eq 'auto') {
                   13726:             $output .= $result.$linefeed;
                   13727:         } else {
                   13728:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13729:         }
1.443     albertel 13730:     }
                   13731:     return $output;
                   13732: }
                   13733: 
                   13734: sub commit_studentrole {
1.1075.2.31  raeburn  13735:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   13736:         $credits) = @_;
1.626     raeburn  13737:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13738:     if ($context eq 'auto') {
                   13739:         $linefeed = "\n";
                   13740:     } else {
                   13741:         $linefeed = '<br />'."\n";
                   13742:     }
1.443     albertel 13743:     if (defined($one) && defined($two)) {
                   13744:         my $cid=$one.'_'.$two;
                   13745:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13746:         my $secchange = 0;
                   13747:         my $expire_role_result;
                   13748:         my $modify_section_result;
1.628     raeburn  13749:         if ($oldsec ne '-1') { 
                   13750:             if ($oldsec ne $sec) {
1.443     albertel 13751:                 $secchange = 1;
1.628     raeburn  13752:                 my $now = time;
1.443     albertel 13753:                 my $uurl='/'.$cid;
                   13754:                 $uurl=~s/\_/\//g;
                   13755:                 if ($oldsec) {
                   13756:                     $uurl.='/'.$oldsec;
                   13757:                 }
1.626     raeburn  13758:                 $oldsecurl = $uurl;
1.628     raeburn  13759:                 $expire_role_result = 
1.652     raeburn  13760:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13761:                 if ($env{'request.course.sec'} ne '') { 
                   13762:                     if ($expire_role_result eq 'refused') {
                   13763:                         my @roles = ('st');
                   13764:                         my @statuses = ('previous');
                   13765:                         my @roledoms = ($one);
                   13766:                         my $withsec = 1;
                   13767:                         my %roleshash = 
                   13768:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13769:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13770:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13771:                             my ($oldstart,$oldend) = 
                   13772:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13773:                             if ($oldend > 0 && $oldend <= $now) {
                   13774:                                 $expire_role_result = 'ok';
                   13775:                             }
                   13776:                         }
                   13777:                     }
                   13778:                 }
1.443     albertel 13779:                 $result = $expire_role_result;
                   13780:             }
                   13781:         }
                   13782:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31  raeburn  13783:             $modify_section_result = 
                   13784:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   13785:                                                            undef,undef,undef,$sec,
                   13786:                                                            $end,$start,'','',$cid,
                   13787:                                                            '',$context,$credits);
1.443     albertel 13788:             if ($modify_section_result =~ /^ok/) {
                   13789:                 if ($secchange == 1) {
1.628     raeburn  13790:                     if ($sec eq '') {
                   13791:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13792:                     } else {
                   13793:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13794:                     }
1.443     albertel 13795:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13796:                     if ($sec eq '') {
                   13797:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13798:                     } else {
                   13799:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13800:                     }
1.443     albertel 13801:                 } else {
1.628     raeburn  13802:                     if ($sec eq '') {
                   13803:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13804:                     } else {
                   13805:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13806:                     }
1.443     albertel 13807:                 }
                   13808:             } else {
1.628     raeburn  13809:                 if ($secchange) {       
                   13810:                     $$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;
                   13811:                 } else {
                   13812:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13813:                 }
1.443     albertel 13814:             }
                   13815:             $result = $modify_section_result;
                   13816:         } elsif ($secchange == 1) {
1.628     raeburn  13817:             if ($oldsec eq '') {
1.1075.2.20  raeburn  13818:                 $$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  13819:             } else {
                   13820:                 $$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;
                   13821:             }
1.626     raeburn  13822:             if ($expire_role_result eq 'refused') {
                   13823:                 my $newsecurl = '/'.$cid;
                   13824:                 $newsecurl =~ s/\_/\//g;
                   13825:                 if ($sec ne '') {
                   13826:                     $newsecurl.='/'.$sec;
                   13827:                 }
                   13828:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13829:                     if ($sec eq '') {
                   13830:                         $$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;
                   13831:                     } else {
                   13832:                         $$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;
                   13833:                     }
                   13834:                 }
                   13835:             }
1.443     albertel 13836:         }
                   13837:     } else {
1.626     raeburn  13838:         $$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 13839:         $result = "error: incomplete course id\n";
                   13840:     }
                   13841:     return $result;
                   13842: }
                   13843: 
1.1075.2.25  raeburn  13844: sub show_role_extent {
                   13845:     my ($scope,$context,$role) = @_;
                   13846:     $scope =~ s{^/}{};
                   13847:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   13848:     push(@courseroles,'co');
                   13849:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   13850:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   13851:         $scope =~ s{/}{_};
                   13852:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   13853:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   13854:         my ($audom,$auname) = split(/\//,$scope);
                   13855:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   13856:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   13857:     } else {
                   13858:         $scope =~ s{/$}{};
                   13859:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   13860:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   13861:     }
                   13862: }
                   13863: 
1.443     albertel 13864: ############################################################
                   13865: ############################################################
                   13866: 
1.566     albertel 13867: sub check_clone {
1.578     raeburn  13868:     my ($args,$linefeed) = @_;
1.566     albertel 13869:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13870:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13871:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13872:     my $clonemsg;
                   13873:     my $can_clone = 0;
1.944     raeburn  13874:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13875:     if ($lctype ne 'community') {
                   13876:         $lctype = 'course';
                   13877:     }
1.566     albertel 13878:     if ($clonehome eq 'no_host') {
1.944     raeburn  13879:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13880:             $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'});
                   13881:         } else {
                   13882:             $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'});
                   13883:         }     
1.566     albertel 13884:     } else {
                   13885: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13886:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13887:             if ($clonedesc{'type'} ne 'Community') {
                   13888:                  $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'});
                   13889:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13890:             }
                   13891:         }
1.882     raeburn  13892: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13893:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13894: 	    $can_clone = 1;
                   13895: 	} else {
                   13896: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13897: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13898: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13899:             if (grep(/^\*$/,@cloners)) {
                   13900:                 $can_clone = 1;
                   13901:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13902:                 $can_clone = 1;
                   13903:             } else {
1.908     raeburn  13904:                 my $ccrole = 'cc';
1.944     raeburn  13905:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13906:                     $ccrole = 'co';
                   13907:                 }
1.578     raeburn  13908: 	        my %roleshash =
                   13909: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13910: 					 $args->{'ccdomain'},
1.908     raeburn  13911:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13912: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13913: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13914:                     $can_clone = 1;
                   13915:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13916:                     $can_clone = 1;
                   13917:                 } else {
1.944     raeburn  13918:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13919:                         $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'});
                   13920:                     } else {
                   13921:                         $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'});
                   13922:                     }
1.578     raeburn  13923: 	        }
1.566     albertel 13924: 	    }
1.578     raeburn  13925:         }
1.566     albertel 13926:     }
                   13927:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13928: }
                   13929: 
1.444     albertel 13930: sub construct_course {
1.1075.2.59  raeburn  13931:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444     albertel 13932:     my $outcome;
1.541     raeburn  13933:     my $linefeed =  '<br />'."\n";
                   13934:     if ($context eq 'auto') {
                   13935:         $linefeed = "\n";
                   13936:     }
1.566     albertel 13937: 
                   13938: #
                   13939: # Are we cloning?
                   13940: #
                   13941:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13942:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13943: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13944: 	if ($context ne 'auto') {
1.578     raeburn  13945:             if ($clonemsg ne '') {
                   13946: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13947:             }
1.566     albertel 13948: 	}
                   13949: 	$outcome .= $clonemsg.$linefeed;
                   13950: 
                   13951:         if (!$can_clone) {
                   13952: 	    return (0,$outcome);
                   13953: 	}
                   13954:     }
                   13955: 
1.444     albertel 13956: #
                   13957: # Open course
                   13958: #
                   13959:     my $crstype = lc($args->{'crstype'});
                   13960:     my %cenv=();
                   13961:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   13962:                                              $args->{'cdescr'},
                   13963:                                              $args->{'curl'},
                   13964:                                              $args->{'course_home'},
                   13965:                                              $args->{'nonstandard'},
                   13966:                                              $args->{'crscode'},
                   13967:                                              $args->{'ccuname'}.':'.
                   13968:                                              $args->{'ccdomain'},
1.882     raeburn  13969:                                              $args->{'crstype'},
1.885     raeburn  13970:                                              $cnum,$context,$category);
1.444     albertel 13971: 
                   13972:     # Note: The testing routines depend on this being output; see 
                   13973:     # Utils::Course. This needs to at least be output as a comment
                   13974:     # if anyone ever decides to not show this, and Utils::Course::new
                   13975:     # will need to be suitably modified.
1.541     raeburn  13976:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  13977:     if ($$courseid =~ /^error:/) {
                   13978:         return (0,$outcome);
                   13979:     }
                   13980: 
1.444     albertel 13981: #
                   13982: # Check if created correctly
                   13983: #
1.479     albertel 13984:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 13985:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  13986:     if ($crsuhome eq 'no_host') {
                   13987:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   13988:         return (0,$outcome);
                   13989:     }
1.541     raeburn  13990:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 13991: 
1.444     albertel 13992: #
1.566     albertel 13993: # Do the cloning
                   13994: #   
                   13995:     if ($can_clone && $cloneid) {
                   13996: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   13997: 	if ($context ne 'auto') {
                   13998: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   13999: 	}
                   14000: 	$outcome .= $clonemsg.$linefeed;
                   14001: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 14002: # Copy all files
1.637     www      14003: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 14004: # Restore URL
1.566     albertel 14005: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 14006: # Restore title
1.566     albertel 14007: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  14008: # Restore creation date, creator and creation context.
                   14009:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   14010:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   14011:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 14012: # Mark as cloned
1.566     albertel 14013: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      14014: # Need to clone grading mode
                   14015:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   14016:         $cenv{'grading'}=$newenv{'grading'};
                   14017: # Do not clone these environment entries
                   14018:         &Apache::lonnet::del('environment',
                   14019:                   ['default_enrollment_start_date',
                   14020:                    'default_enrollment_end_date',
                   14021:                    'question.email',
                   14022:                    'policy.email',
                   14023:                    'comment.email',
                   14024:                    'pch.users.denied',
1.725     raeburn  14025:                    'plc.users.denied',
                   14026:                    'hidefromcat',
1.1075.2.36  raeburn  14027:                    'checkforpriv',
1.1075.2.59  raeburn  14028:                    'categories',
                   14029:                    'internal.uniquecode'],
1.638     www      14030:                    $$crsudom,$$crsunum);
1.1075.2.63  raeburn  14031:         if ($args->{'textbook'}) {
                   14032:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   14033:         }
1.444     albertel 14034:     }
1.566     albertel 14035: 
1.444     albertel 14036: #
                   14037: # Set environment (will override cloned, if existing)
                   14038: #
                   14039:     my @sections = ();
                   14040:     my @xlists = ();
                   14041:     if ($args->{'crstype'}) {
                   14042:         $cenv{'type'}=$args->{'crstype'};
                   14043:     }
                   14044:     if ($args->{'crsid'}) {
                   14045:         $cenv{'courseid'}=$args->{'crsid'};
                   14046:     }
                   14047:     if ($args->{'crscode'}) {
                   14048:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   14049:     }
                   14050:     if ($args->{'crsquota'} ne '') {
                   14051:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   14052:     } else {
                   14053:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   14054:     }
                   14055:     if ($args->{'ccuname'}) {
                   14056:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   14057:                                         ':'.$args->{'ccdomain'};
                   14058:     } else {
                   14059:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   14060:     }
1.1075.2.31  raeburn  14061:     if ($args->{'defaultcredits'}) {
                   14062:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   14063:     }
1.444     albertel 14064:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   14065:     if ($args->{'crssections'}) {
                   14066:         $cenv{'internal.sectionnums'} = '';
                   14067:         if ($args->{'crssections'} =~ m/,/) {
                   14068:             @sections = split/,/,$args->{'crssections'};
                   14069:         } else {
                   14070:             $sections[0] = $args->{'crssections'};
                   14071:         }
                   14072:         if (@sections > 0) {
                   14073:             foreach my $item (@sections) {
                   14074:                 my ($sec,$gp) = split/:/,$item;
                   14075:                 my $class = $args->{'crscode'}.$sec;
                   14076:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   14077:                 $cenv{'internal.sectionnums'} .= $item.',';
                   14078:                 unless ($addcheck eq 'ok') {
                   14079:                     push @badclasses, $class;
                   14080:                 }
                   14081:             }
                   14082:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   14083:         }
                   14084:     }
                   14085: # do not hide course coordinator from staff listing, 
                   14086: # even if privileged
                   14087:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36  raeburn  14088: # add course coordinator's domain to domains to check for privileged users
                   14089: # if different to course domain
                   14090:     if ($$crsudom ne $args->{'ccdomain'}) {
                   14091:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   14092:     }
1.444     albertel 14093: # add crosslistings
                   14094:     if ($args->{'crsxlist'}) {
                   14095:         $cenv{'internal.crosslistings'}='';
                   14096:         if ($args->{'crsxlist'} =~ m/,/) {
                   14097:             @xlists = split/,/,$args->{'crsxlist'};
                   14098:         } else {
                   14099:             $xlists[0] = $args->{'crsxlist'};
                   14100:         }
                   14101:         if (@xlists > 0) {
                   14102:             foreach my $item (@xlists) {
                   14103:                 my ($xl,$gp) = split/:/,$item;
                   14104:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   14105:                 $cenv{'internal.crosslistings'} .= $item.',';
                   14106:                 unless ($addcheck eq 'ok') {
                   14107:                     push @badclasses, $xl;
                   14108:                 }
                   14109:             }
                   14110:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   14111:         }
                   14112:     }
                   14113:     if ($args->{'autoadds'}) {
                   14114:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   14115:     }
                   14116:     if ($args->{'autodrops'}) {
                   14117:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   14118:     }
                   14119: # check for notification of enrollment changes
                   14120:     my @notified = ();
                   14121:     if ($args->{'notify_owner'}) {
                   14122:         if ($args->{'ccuname'} ne '') {
                   14123:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   14124:         }
                   14125:     }
                   14126:     if ($args->{'notify_dc'}) {
                   14127:         if ($uname ne '') { 
1.630     raeburn  14128:             push(@notified,$uname.':'.$udom);
1.444     albertel 14129:         }
                   14130:     }
                   14131:     if (@notified > 0) {
                   14132:         my $notifylist;
                   14133:         if (@notified > 1) {
                   14134:             $notifylist = join(',',@notified);
                   14135:         } else {
                   14136:             $notifylist = $notified[0];
                   14137:         }
                   14138:         $cenv{'internal.notifylist'} = $notifylist;
                   14139:     }
                   14140:     if (@badclasses > 0) {
                   14141:         my %lt=&Apache::lonlocal::texthash(
                   14142:                 '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',
                   14143:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   14144:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   14145:         );
1.541     raeburn  14146:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   14147:                            ' ('.$lt{'adby'}.')';
                   14148:         if ($context eq 'auto') {
                   14149:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 14150:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  14151:             foreach my $item (@badclasses) {
                   14152:                 if ($context eq 'auto') {
                   14153:                     $outcome .= " - $item\n";
                   14154:                 } else {
                   14155:                     $outcome .= "<li>$item</li>\n";
                   14156:                 }
                   14157:             }
                   14158:             if ($context eq 'auto') {
                   14159:                 $outcome .= $linefeed;
                   14160:             } else {
1.566     albertel 14161:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14162:             }
                   14163:         } 
1.444     albertel 14164:     }
                   14165:     if ($args->{'no_end_date'}) {
                   14166:         $args->{'endaccess'} = 0;
                   14167:     }
                   14168:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14169:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14170:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14171:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14172:     if ($args->{'showphotos'}) {
                   14173:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14174:     }
                   14175:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14176:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14177:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14178:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14179:             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'); 
                   14180:             if ($context eq 'auto') {
                   14181:                 $outcome .= $krb_msg;
                   14182:             } else {
1.566     albertel 14183:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14184:             }
                   14185:             $outcome .= $linefeed;
1.444     albertel 14186:         }
                   14187:     }
                   14188:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14189:        if ($args->{'setpolicy'}) {
                   14190:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14191:        }
                   14192:        if ($args->{'setcontent'}) {
                   14193:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14194:        }
                   14195:     }
                   14196:     if ($args->{'reshome'}) {
                   14197: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14198: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14199:     }
                   14200: #
                   14201: # course has keyed access
                   14202: #
                   14203:     if ($args->{'setkeys'}) {
                   14204:        $cenv{'keyaccess'}='yes';
                   14205:     }
                   14206: # if specified, key authority is not course, but user
                   14207: # only active if keyaccess is yes
                   14208:     if ($args->{'keyauth'}) {
1.487     albertel 14209: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14210: 	$user = &LONCAPA::clean_username($user);
                   14211: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14212: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14213: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14214: 	}
                   14215:     }
                   14216: 
1.1075.2.59  raeburn  14217: #
                   14218: #  generate and store uniquecode (available to course requester), if course should have one.
                   14219: #
                   14220:     if ($args->{'uniquecode'}) {
                   14221:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   14222:         if ($code) {
                   14223:             $cenv{'internal.uniquecode'} = $code;
                   14224:             my %crsinfo =
                   14225:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   14226:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   14227:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   14228:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   14229:             }
                   14230:             if (ref($coderef)) {
                   14231:                 $$coderef = $code;
                   14232:             }
                   14233:         }
                   14234:     }
                   14235: 
1.444     albertel 14236:     if ($args->{'disresdis'}) {
                   14237:         $cenv{'pch.roles.denied'}='st';
                   14238:     }
                   14239:     if ($args->{'disablechat'}) {
                   14240:         $cenv{'plc.roles.denied'}='st';
                   14241:     }
                   14242: 
                   14243:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14244:     # course
                   14245:     $cenv{'course.helper.not.run'} = 1;
                   14246:     #
                   14247:     # Use new Randomseed
                   14248:     #
                   14249:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14250:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14251:     #
                   14252:     # The encryption code and receipt prefix for this course
                   14253:     #
                   14254:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14255:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14256:     #
                   14257:     # By default, use standard grading
                   14258:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14259: 
1.541     raeburn  14260:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14261:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14262: #
                   14263: # Open all assignments
                   14264: #
                   14265:     if ($args->{'openall'}) {
                   14266:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14267:        my %storecontent = ($storeunder         => time,
                   14268:                            $storeunder.'.type' => 'date_start');
                   14269:        
                   14270:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14271:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14272:    }
                   14273: #
                   14274: # Set first page
                   14275: #
                   14276:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14277: 	    || ($cloneid)) {
1.445     albertel 14278: 	use LONCAPA::map;
1.444     albertel 14279: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14280: 
                   14281: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14282:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14283: 
1.444     albertel 14284:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14285:         my $title; my $url;
                   14286:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14287: 	    $title=&mt('Syllabus');
1.444     albertel 14288:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14289:         } else {
1.963     raeburn  14290:             $title=&mt('Table of Contents');
1.444     albertel 14291:             $url='/adm/navmaps';
                   14292:         }
1.445     albertel 14293: 
                   14294:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14295: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14296: 
                   14297: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14298:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14299:     }
1.566     albertel 14300: 
                   14301:     return (1,$outcome);
1.444     albertel 14302: }
                   14303: 
1.1075.2.59  raeburn  14304: sub make_unique_code {
                   14305:     my ($cdom,$cnum) = @_;
                   14306:     # get lock on uniquecodes db
                   14307:     my $lockhash = {
                   14308:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   14309:                                                   ':'.$env{'user.domain'},
                   14310:                    };
                   14311:     my $tries = 0;
                   14312:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14313:     my ($code,$error);
                   14314: 
                   14315:     while (($gotlock ne 'ok') && ($tries<3)) {
                   14316:         $tries ++;
                   14317:         sleep 1;
                   14318:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14319:     }
                   14320:     if ($gotlock eq 'ok') {
                   14321:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   14322:         my $gotcode;
                   14323:         my $attempts = 0;
                   14324:         while ((!$gotcode) && ($attempts < 100)) {
                   14325:             $code = &generate_code();
                   14326:             if (!exists($currcodes{$code})) {
                   14327:                 $gotcode = 1;
                   14328:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   14329:                     $error = 'nostore';
                   14330:                 }
                   14331:             }
                   14332:             $attempts ++;
                   14333:         }
                   14334:         my @del_lock = ($cnum."\0".'uniquecodes');
                   14335:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   14336:     } else {
                   14337:         $error = 'nolock';
                   14338:     }
                   14339:     return ($code,$error);
                   14340: }
                   14341: 
                   14342: sub generate_code {
                   14343:     my $code;
                   14344:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   14345:     for (my $i=0; $i<6; $i++) {
                   14346:         my $lettnum = int (rand 2);
                   14347:         my $item = '';
                   14348:         if ($lettnum) {
                   14349:             $item = $letts[int( rand(18) )];
                   14350:         } else {
                   14351:             $item = 1+int( rand(8) );
                   14352:         }
                   14353:         $code .= $item;
                   14354:     }
                   14355:     return $code;
                   14356: }
                   14357: 
1.444     albertel 14358: ############################################################
                   14359: ############################################################
                   14360: 
1.953     droeschl 14361: #SD
                   14362: # only Community and Course, or anything else?
1.378     raeburn  14363: sub course_type {
                   14364:     my ($cid) = @_;
                   14365:     if (!defined($cid)) {
                   14366:         $cid = $env{'request.course.id'};
                   14367:     }
1.404     albertel 14368:     if (defined($env{'course.'.$cid.'.type'})) {
                   14369:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  14370:     } else {
                   14371:         return 'Course';
1.377     raeburn  14372:     }
                   14373: }
1.156     albertel 14374: 
1.406     raeburn  14375: sub group_term {
                   14376:     my $crstype = &course_type();
                   14377:     my %names = (
                   14378:                   'Course' => 'group',
1.865     raeburn  14379:                   'Community' => 'group',
1.406     raeburn  14380:                 );
                   14381:     return $names{$crstype};
                   14382: }
                   14383: 
1.902     raeburn  14384: sub course_types {
1.1075.2.59  raeburn  14385:     my @types = ('official','unofficial','community','textbook');
1.902     raeburn  14386:     my %typename = (
                   14387:                          official   => 'Official course',
                   14388:                          unofficial => 'Unofficial course',
                   14389:                          community  => 'Community',
1.1075.2.59  raeburn  14390:                          textbook   => 'Textbook course',
1.902     raeburn  14391:                    );
                   14392:     return (\@types,\%typename);
                   14393: }
                   14394: 
1.156     albertel 14395: sub icon {
                   14396:     my ($file)=@_;
1.505     albertel 14397:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 14398:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 14399:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 14400:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   14401: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   14402: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14403: 	            $curfext.".gif") {
                   14404: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14405: 		$curfext.".gif";
                   14406: 	}
                   14407:     }
1.249     albertel 14408:     return &lonhttpdurl($iconname);
1.154     albertel 14409: } 
1.84      albertel 14410: 
1.575     albertel 14411: sub lonhttpdurl {
1.692     www      14412: #
                   14413: # Had been used for "small fry" static images on separate port 8080.
                   14414: # Modify here if lightweight http functionality desired again.
                   14415: # Currently eliminated due to increasing firewall issues.
                   14416: #
1.575     albertel 14417:     my ($url)=@_;
1.692     www      14418:     return $url;
1.215     albertel 14419: }
                   14420: 
1.213     albertel 14421: sub connection_aborted {
                   14422:     my ($r)=@_;
                   14423:     $r->print(" ");$r->rflush();
                   14424:     my $c = $r->connection;
                   14425:     return $c->aborted();
                   14426: }
                   14427: 
1.221     foxr     14428: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     14429: #    strings as 'strings'.
                   14430: sub escape_single {
1.221     foxr     14431:     my ($input) = @_;
1.223     albertel 14432:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     14433:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   14434:     return $input;
                   14435: }
1.223     albertel 14436: 
1.222     foxr     14437: #  Same as escape_single, but escape's "'s  This 
                   14438: #  can be used for  "strings"
                   14439: sub escape_double {
                   14440:     my ($input) = @_;
                   14441:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   14442:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   14443:     return $input;
                   14444: }
1.223     albertel 14445:  
1.222     foxr     14446: #   Escapes the last element of a full URL.
                   14447: sub escape_url {
                   14448:     my ($url)   = @_;
1.238     raeburn  14449:     my @urlslices = split(/\//, $url,-1);
1.369     www      14450:     my $lastitem = &escape(pop(@urlslices));
1.223     albertel 14451:     return join('/',@urlslices).'/'.$lastitem;
1.222     foxr     14452: }
1.462     albertel 14453: 
1.820     raeburn  14454: sub compare_arrays {
                   14455:     my ($arrayref1,$arrayref2) = @_;
                   14456:     my (@difference,%count);
                   14457:     @difference = ();
                   14458:     %count = ();
                   14459:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   14460:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   14461:         foreach my $element (keys(%count)) {
                   14462:             if ($count{$element} == 1) {
                   14463:                 push(@difference,$element);
                   14464:             }
                   14465:         }
                   14466:     }
                   14467:     return @difference;
                   14468: }
                   14469: 
1.817     bisitz   14470: # -------------------------------------------------------- Initialize user login
1.462     albertel 14471: sub init_user_environment {
1.463     albertel 14472:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 14473:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   14474: 
                   14475:     my $public=($username eq 'public' && $domain eq 'public');
                   14476: 
                   14477: # See if old ID present, if so, remove
                   14478: 
1.1062    raeburn  14479:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 14480:     my $now=time;
                   14481: 
                   14482:     if ($public) {
                   14483: 	my $max_public=100;
                   14484: 	my $oldest;
                   14485: 	my $oldest_time=0;
                   14486: 	for(my $next=1;$next<=$max_public;$next++) {
                   14487: 	    if (-e $lonids."/publicuser_$next.id") {
                   14488: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   14489: 		if ($mtime<$oldest_time || !$oldest_time) {
                   14490: 		    $oldest_time=$mtime;
                   14491: 		    $oldest=$next;
                   14492: 		}
                   14493: 	    } else {
                   14494: 		$cookie="publicuser_$next";
                   14495: 		last;
                   14496: 	    }
                   14497: 	}
                   14498: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   14499:     } else {
1.463     albertel 14500: 	# if this isn't a robot, kill any existing non-robot sessions
                   14501: 	if (!$args->{'robot'}) {
                   14502: 	    opendir(DIR,$lonids);
                   14503: 	    while ($filename=readdir(DIR)) {
                   14504: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   14505: 		    unlink($lonids.'/'.$filename);
                   14506: 		}
1.462     albertel 14507: 	    }
1.463     albertel 14508: 	    closedir(DIR);
1.462     albertel 14509: 	}
                   14510: # Give them a new cookie
1.463     albertel 14511: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      14512: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 14513: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 14514:     
                   14515: # Initialize roles
                   14516: 
1.1062    raeburn  14517: 	($userroles,$firstaccenv,$timerintenv) = 
                   14518:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 14519:     }
                   14520: # ------------------------------------ Check browser type and MathML capability
                   14521: 
                   14522:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.42  raeburn  14523:         $clientunicode,$clientos,$clientmobile,$clientinfo) = &decode_user_agent($r);
1.462     albertel 14524: 
                   14525: # ------------------------------------------------------------- Get environment
                   14526: 
                   14527:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   14528:     my ($tmp) = keys(%userenv);
                   14529:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   14530:     } else {
                   14531: 	undef(%userenv);
                   14532:     }
                   14533:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   14534: 	$form->{'interface'}=$userenv{'interface'};
                   14535:     }
                   14536:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   14537: 
                   14538: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   14539:     foreach my $option ('interface','localpath','localres') {
                   14540:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 14541:     }
                   14542: # --------------------------------------------------------- Write first profile
                   14543: 
                   14544:     {
                   14545: 	my %initial_env = 
                   14546: 	    ("user.name"          => $username,
                   14547: 	     "user.domain"        => $domain,
                   14548: 	     "user.home"          => $authhost,
                   14549: 	     "browser.type"       => $clientbrowser,
                   14550: 	     "browser.version"    => $clientversion,
                   14551: 	     "browser.mathml"     => $clientmathml,
                   14552: 	     "browser.unicode"    => $clientunicode,
                   14553: 	     "browser.os"         => $clientos,
1.1075.2.42  raeburn  14554:              "browser.mobile"     => $clientmobile,
                   14555:              "browser.info"       => $clientinfo,
1.462     albertel 14556: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   14557: 	     "request.course.fn"  => '',
                   14558: 	     "request.course.uri" => '',
                   14559: 	     "request.course.sec" => '',
                   14560: 	     "request.role"       => 'cm',
                   14561: 	     "request.role.adv"   => $env{'user.adv'},
                   14562: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   14563: 
                   14564:         if ($form->{'localpath'}) {
                   14565: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   14566: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   14567:         }
                   14568: 	
                   14569: 	if ($form->{'interface'}) {
                   14570: 	    $form->{'interface'}=~s/\W//gs;
                   14571: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   14572: 	    $env{'browser.interface'}=$form->{'interface'};
                   14573: 	}
                   14574: 
1.1075.2.54  raeburn  14575:         if ($form->{'iptoken'}) {
                   14576:             my $lonhost = $r->dir_config('lonHostID');
                   14577:             $initial_env{"user.noloadbalance"} = $lonhost;
                   14578:             $env{'user.noloadbalance'} = $lonhost;
                   14579:         }
                   14580: 
1.981     raeburn  14581:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  14582:         my %domdef;
                   14583:         unless ($domain eq 'public') {
                   14584:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   14585:         }
1.980     raeburn  14586: 
1.1075.2.7  raeburn  14587:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  14588:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  14589:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   14590:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  14591:         }
                   14592: 
1.1075.2.59  raeburn  14593:         foreach my $crstype ('official','unofficial','community','textbook') {
1.765     raeburn  14594:             $userenv{'canrequest.'.$crstype} =
                   14595:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  14596:                                                   'reload','requestcourses',
                   14597:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  14598:         }
                   14599: 
1.1075.2.14  raeburn  14600:         $userenv{'canrequest.author'} =
                   14601:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   14602:                                         'reload','requestauthor',
                   14603:                                         \%userenv,\%domdef,\%is_adv);
                   14604:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   14605:                                              $domain,$username);
                   14606:         my $reqstatus = $reqauthor{'author_status'};
                   14607:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   14608:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   14609:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   14610:                                                   $reqauthor{'author'}{'timestamp'};
                   14611:             }
                   14612:         }
                   14613: 
1.462     albertel 14614: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  14615: 
1.462     albertel 14616: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   14617: 		 &GDBM_WRCREAT(),0640)) {
                   14618: 	    &_add_to_env(\%disk_env,\%initial_env);
                   14619: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   14620: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  14621:             if (ref($firstaccenv) eq 'HASH') {
                   14622:                 &_add_to_env(\%disk_env,$firstaccenv);
                   14623:             }
                   14624:             if (ref($timerintenv) eq 'HASH') {
                   14625:                 &_add_to_env(\%disk_env,$timerintenv);
                   14626:             }
1.463     albertel 14627: 	    if (ref($args->{'extra_env'})) {
                   14628: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   14629: 	    }
1.462     albertel 14630: 	    untie(%disk_env);
                   14631: 	} else {
1.705     tempelho 14632: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   14633: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 14634: 	    return 'error: '.$!;
                   14635: 	}
                   14636:     }
                   14637:     $env{'request.role'}='cm';
                   14638:     $env{'request.role.adv'}=$env{'user.adv'};
                   14639:     $env{'browser.type'}=$clientbrowser;
                   14640: 
                   14641:     return $cookie;
                   14642: 
                   14643: }
                   14644: 
                   14645: sub _add_to_env {
                   14646:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14647:     if (ref($env_data) eq 'HASH') {
                   14648:         while (my ($key,$value) = each(%$env_data)) {
                   14649: 	    $idf->{$prefix.$key} = $value;
                   14650: 	    $env{$prefix.$key}   = $value;
                   14651:         }
1.462     albertel 14652:     }
                   14653: }
                   14654: 
1.685     tempelho 14655: # --- Get the symbolic name of a problem and the url
                   14656: sub get_symb {
                   14657:     my ($request,$silent) = @_;
1.726     raeburn  14658:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14659:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14660:     if ($symb eq '') {
                   14661:         if (!$silent) {
1.1071    raeburn  14662:             if (ref($request)) { 
                   14663:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14664:             }
1.685     tempelho 14665:             return ();
                   14666:         }
                   14667:     }
                   14668:     &Apache::lonenc::check_decrypt(\$symb);
                   14669:     return ($symb);
                   14670: }
                   14671: 
                   14672: # --------------------------------------------------------------Get annotation
                   14673: 
                   14674: sub get_annotation {
                   14675:     my ($symb,$enc) = @_;
                   14676: 
                   14677:     my $key = $symb;
                   14678:     if (!$enc) {
                   14679:         $key =
                   14680:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14681:     }
                   14682:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14683:     return $annotation{$key};
                   14684: }
                   14685: 
                   14686: sub clean_symb {
1.731     raeburn  14687:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14688: 
                   14689:     &Apache::lonenc::check_decrypt(\$symb);
                   14690:     my $enc = $env{'request.enc'};
1.731     raeburn  14691:     if ($delete_enc) {
1.730     raeburn  14692:         delete($env{'request.enc'});
                   14693:     }
1.685     tempelho 14694: 
                   14695:     return ($symb,$enc);
                   14696: }
1.462     albertel 14697: 
1.1075.2.69  raeburn  14698: ############################################################
                   14699: ############################################################
                   14700: 
                   14701: =pod
                   14702: 
                   14703: =head1 Routines for building display used to search for courses
                   14704: 
                   14705: 
                   14706: =over 4
                   14707: 
                   14708: =item * &build_filters()
                   14709: 
                   14710: Create markup for a table used to set filters to use when selecting
                   14711: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   14712: and quotacheck.pl
                   14713: 
                   14714: 
                   14715: Inputs:
                   14716: 
                   14717: filterlist - anonymous array of fields to include as potential filters
                   14718: 
                   14719: crstype - course type
                   14720: 
                   14721: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   14722:               to pop-open a course selector (will contain "extra element").
                   14723: 
                   14724: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   14725: 
                   14726: filter - anonymous hash of criteria and their values
                   14727: 
                   14728: action - form action
                   14729: 
                   14730: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   14731: 
                   14732: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
                   14733: 
                   14734: cloneruname - username of owner of new course who wants to clone
                   14735: 
                   14736: clonerudom - domain of owner of new course who wants to clone
                   14737: 
                   14738: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
                   14739: 
                   14740: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   14741: 
                   14742: codedom - domain
                   14743: 
                   14744: formname - value of form element named "form".
                   14745: 
                   14746: fixeddom - domain, if fixed.
                   14747: 
                   14748: prevphase - value to assign to form element named "phase" when going back to the previous screen
                   14749: 
                   14750: cnameelement - name of form element in form on opener page which will receive title of selected course
                   14751: 
                   14752: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   14753: 
                   14754: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   14755: 
                   14756: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   14757: 
                   14758: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   14759: 
                   14760: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   14761: 
                   14762: 
                   14763: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   14764: 
                   14765: 
                   14766: Side Effects: None
                   14767: 
                   14768: =cut
                   14769: 
                   14770: # ---------------------------------------------- search for courses based on last activity etc.
                   14771: 
                   14772: sub build_filters {
                   14773:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   14774:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   14775:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   14776:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   14777:         $clonetext,$clonewarning) = @_;
                   14778:     my ($list,$jscript);
                   14779:     my $onchange = 'javascript:updateFilters(this)';
                   14780:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   14781:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   14782:         $typeselectform,$instcodetitle);
                   14783:     if ($formname eq '') {
                   14784:         $formname = $caller;
                   14785:     }
                   14786:     foreach my $item (@{$filterlist}) {
                   14787:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   14788:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   14789:             if ($item eq 'domainfilter') {
                   14790:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   14791:             } elsif ($item eq 'coursefilter') {
                   14792:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   14793:             } elsif ($item eq 'ownerfilter') {
                   14794:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14795:             } elsif ($item eq 'ownerdomfilter') {
                   14796:                 $filter->{'ownerdomfilter'} =
                   14797:                     &LONCAPA::clean_domain($filter->{$item});
                   14798:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   14799:                                                        'ownerdomfilter',1);
                   14800:             } elsif ($item eq 'personfilter') {
                   14801:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14802:             } elsif ($item eq 'persondomfilter') {
                   14803:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   14804:                                                         'persondomfilter',1);
                   14805:             } else {
                   14806:                 $filter->{$item} =~ s/\W//g;
                   14807:             }
                   14808:             if (!$filter->{$item}) {
                   14809:                 $filter->{$item} = '';
                   14810:             }
                   14811:         }
                   14812:         if ($item eq 'domainfilter') {
                   14813:             my $allow_blank = 1;
                   14814:             if ($formname eq 'portform') {
                   14815:                 $allow_blank=0;
                   14816:             } elsif ($formname eq 'studentform') {
                   14817:                 $allow_blank=0;
                   14818:             }
                   14819:             if ($fixeddom) {
                   14820:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   14821:                                     ' value="'.$codedom.'" />'.
                   14822:                                     &Apache::lonnet::domain($codedom,'description');
                   14823:             } else {
                   14824:                 $domainselectform = &select_dom_form($filter->{$item},
                   14825:                                                      'domainfilter',
                   14826:                                                       $allow_blank,'',$onchange);
                   14827:             }
                   14828:         } else {
                   14829:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   14830:         }
                   14831:     }
                   14832: 
                   14833:     # last course activity filter and selection
                   14834:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   14835: 
                   14836:     # course created filter and selection
                   14837:     if (exists($filter->{'createdfilter'})) {
                   14838:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   14839:     }
                   14840: 
                   14841:     my %lt = &Apache::lonlocal::texthash(
                   14842:                 'cac' => "$crstype Activity",
                   14843:                 'ccr' => "$crstype Created",
                   14844:                 'cde' => "$crstype Title",
                   14845:                 'cdo' => "$crstype Domain",
                   14846:                 'ins' => 'Institutional Code',
                   14847:                 'inc' => 'Institutional Categorization',
                   14848:                 'cow' => "$crstype Owner/Co-owner",
                   14849:                 'cop' => "$crstype Personnel Includes",
                   14850:                 'cog' => 'Type',
                   14851:              );
                   14852: 
                   14853:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   14854:         my $typeval = 'Course';
                   14855:         if ($crstype eq 'Community') {
                   14856:             $typeval = 'Community';
                   14857:         }
                   14858:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   14859:     } else {
                   14860:         $typeselectform =  '<select name="type" size="1"';
                   14861:         if ($onchange) {
                   14862:             $typeselectform .= ' onchange="'.$onchange.'"';
                   14863:         }
                   14864:         $typeselectform .= '>'."\n";
                   14865:         foreach my $posstype ('Course','Community') {
                   14866:             $typeselectform.='<option value="'.$posstype.'"'.
                   14867:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
                   14868:         }
                   14869:         $typeselectform.="</select>";
                   14870:     }
                   14871: 
                   14872:     my ($cloneableonlyform,$cloneabletitle);
                   14873:     if (exists($filter->{'cloneableonly'})) {
                   14874:         my $cloneableon = '';
                   14875:         my $cloneableoff = ' checked="checked"';
                   14876:         if ($filter->{'cloneableonly'}) {
                   14877:             $cloneableon = $cloneableoff;
                   14878:             $cloneableoff = '';
                   14879:         }
                   14880:         $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>';
                   14881:         if ($formname eq 'ccrs') {
1.1075.2.71  raeburn  14882:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69  raeburn  14883:         } else {
                   14884:             $cloneabletitle = &mt('Cloneable by you');
                   14885:         }
                   14886:     }
                   14887:     my $officialjs;
                   14888:     if ($crstype eq 'Course') {
                   14889:         if (exists($filter->{'instcodefilter'})) {
                   14890: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   14891: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   14892:             if ($codedom) {
                   14893:                 $officialjs = 1;
                   14894:                 ($instcodeform,$jscript,$$numtitlesref) =
                   14895:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   14896:                                                                   $officialjs,$codetitlesref);
                   14897:                 if ($jscript) {
                   14898:                     $jscript = '<script type="text/javascript">'."\n".
                   14899:                                '// <![CDATA['."\n".
                   14900:                                $jscript."\n".
                   14901:                                '// ]]>'."\n".
                   14902:                                '</script>'."\n";
                   14903:                 }
                   14904:             }
                   14905:             if ($instcodeform eq '') {
                   14906:                 $instcodeform =
                   14907:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   14908:                     $list->{'instcodefilter'}.'" />';
                   14909:                 $instcodetitle = $lt{'ins'};
                   14910:             } else {
                   14911:                 $instcodetitle = $lt{'inc'};
                   14912:             }
                   14913:             if ($fixeddom) {
                   14914:                 $instcodetitle .= '<br />('.$codedom.')';
                   14915:             }
                   14916:         }
                   14917:     }
                   14918:     my $output = qq|
                   14919: <form method="post" name="filterpicker" action="$action">
                   14920: <input type="hidden" name="form" value="$formname" />
                   14921: |;
                   14922:     if ($formname eq 'modifycourse') {
                   14923:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   14924:                    '<input type="hidden" name="prevphase" value="'.
                   14925:                    $prevphase.'" />'."\n";
                   14926:     } elsif ($formname ne 'quotacheck') {
                   14927:         my $name_input;
                   14928:         if ($cnameelement ne '') {
                   14929:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   14930:                           $cnameelement.'" />';
                   14931:         }
                   14932:         $output .= qq|
                   14933: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   14934: <input type="hidden" name="cdomelement" value="$cdomelement" />
                   14935: $name_input
                   14936: $roleelement
                   14937: $multelement
                   14938: $typeelement
                   14939: |;
                   14940:         if ($formname eq 'portform') {
                   14941:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   14942:         }
                   14943:     }
                   14944:     if ($fixeddom) {
                   14945:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   14946:     }
                   14947:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   14948:     if ($sincefilterform) {
                   14949:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   14950:                   .$sincefilterform
                   14951:                   .&Apache::lonhtmlcommon::row_closure();
                   14952:     }
                   14953:     if ($createdfilterform) {
                   14954:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   14955:                   .$createdfilterform
                   14956:                   .&Apache::lonhtmlcommon::row_closure();
                   14957:     }
                   14958:     if ($domainselectform) {
                   14959:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   14960:                   .$domainselectform
                   14961:                   .&Apache::lonhtmlcommon::row_closure();
                   14962:     }
                   14963:     if ($typeselectform) {
                   14964:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   14965:             $output .= $typeselectform;
                   14966:         } else {
                   14967:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   14968:                       .$typeselectform
                   14969:                       .&Apache::lonhtmlcommon::row_closure();
                   14970:         }
                   14971:     }
                   14972:     if ($instcodeform) {
                   14973:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   14974:                   .$instcodeform
                   14975:                   .&Apache::lonhtmlcommon::row_closure();
                   14976:     }
                   14977:     if (exists($filter->{'ownerfilter'})) {
                   14978:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   14979:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   14980:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   14981:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   14982:                    $ownerdomselectform.'</td></tr></table>'.
                   14983:                    &Apache::lonhtmlcommon::row_closure();
                   14984:     }
                   14985:     if (exists($filter->{'personfilter'})) {
                   14986:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   14987:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   14988:                    '<input type="text" name="personfilter" size="20" value="'.
                   14989:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   14990:                    $persondomselectform.'</td></tr></table>'.
                   14991:                    &Apache::lonhtmlcommon::row_closure();
                   14992:     }
                   14993:     if (exists($filter->{'coursefilter'})) {
                   14994:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   14995:                   .'<input type="text" name="coursefilter" size="25" value="'
                   14996:                   .$list->{'coursefilter'}.'" />'
                   14997:                   .&Apache::lonhtmlcommon::row_closure();
                   14998:     }
                   14999:     if ($cloneableonlyform) {
                   15000:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   15001:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   15002:     }
                   15003:     if (exists($filter->{'descriptfilter'})) {
                   15004:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   15005:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   15006:                   .$list->{'descriptfilter'}.'" />'
                   15007:                   .&Apache::lonhtmlcommon::row_closure(1);
                   15008:     }
                   15009:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   15010:                '<input type="hidden" name="updater" value="" />'."\n".
                   15011:                '<input type="submit" name="gosearch" value="'.
                   15012:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   15013:     return $jscript.$clonewarning.$output;
                   15014: }
                   15015: 
                   15016: =pod
                   15017: 
                   15018: =item * &timebased_select_form()
                   15019: 
                   15020: Create markup for a dropdown list used to select a time-based
                   15021: filter e.g., Course Activity, Course Created, when searching for courses
                   15022: or communities
                   15023: 
                   15024: Inputs:
                   15025: 
                   15026: item - name of form element (sincefilter or createdfilter)
                   15027: 
                   15028: filter - anonymous hash of criteria and their values
                   15029: 
                   15030: Returns: HTML for a select box contained a blank, then six time selections,
                   15031:          with value set in incoming form variables currently selected.
                   15032: 
                   15033: Side Effects: None
                   15034: 
                   15035: =cut
                   15036: 
                   15037: sub timebased_select_form {
                   15038:     my ($item,$filter) = @_;
                   15039:     if (ref($filter) eq 'HASH') {
                   15040:         $filter->{$item} =~ s/[^\d-]//g;
                   15041:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   15042:         return &select_form(
                   15043:                             $filter->{$item},
                   15044:                             $item,
                   15045:                             {      '-1' => '',
                   15046:                                 '86400' => &mt('today'),
                   15047:                                '604800' => &mt('last week'),
                   15048:                               '2592000' => &mt('last month'),
                   15049:                               '7776000' => &mt('last three months'),
                   15050:                              '15552000' => &mt('last six months'),
                   15051:                              '31104000' => &mt('last year'),
                   15052:                     'select_form_order' =>
                   15053:                            ['-1','86400','604800','2592000','7776000',
                   15054:                             '15552000','31104000']});
                   15055:     }
                   15056: }
                   15057: 
                   15058: =pod
                   15059: 
                   15060: =item * &js_changer()
                   15061: 
                   15062: Create script tag containing Javascript used to submit course search form
                   15063: when course type or domain is changed, and also to hide 'Searching ...' on
                   15064: page load completion for page showing search result.
                   15065: 
                   15066: Inputs: None
                   15067: 
                   15068: Returns: markup containing updateFilters() and hideSearching() javascript functions.
                   15069: 
                   15070: Side Effects: None
                   15071: 
                   15072: =cut
                   15073: 
                   15074: sub js_changer {
                   15075:     return <<ENDJS;
                   15076: <script type="text/javascript">
                   15077: // <![CDATA[
                   15078: function updateFilters(caller) {
                   15079:     if (typeof(caller) != "undefined") {
                   15080:         document.filterpicker.updater.value = caller.name;
                   15081:     }
                   15082:     document.filterpicker.submit();
                   15083: }
                   15084: 
                   15085: function hideSearching() {
                   15086:     if (document.getElementById('searching')) {
                   15087:         document.getElementById('searching').style.display = 'none';
                   15088:     }
                   15089:     return;
                   15090: }
                   15091: 
                   15092: // ]]>
                   15093: </script>
                   15094: 
                   15095: ENDJS
                   15096: }
                   15097: 
                   15098: =pod
                   15099: 
                   15100: =item * &search_courses()
                   15101: 
                   15102: Process selected filters form course search form and pass to lonnet::courseiddump
                   15103: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   15104: 
                   15105: Inputs:
                   15106: 
                   15107: dom - domain being searched
                   15108: 
                   15109: type - course type ('Course' or 'Community' or '.' if any).
                   15110: 
                   15111: filter - anonymous hash of criteria and their values
                   15112: 
                   15113: numtitles - for institutional codes - number of categories
                   15114: 
                   15115: cloneruname - optional username of new course owner
                   15116: 
                   15117: clonerudom - optional domain of new course owner
                   15118: 
                   15119: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
                   15120:             (used when DC is using course creation form)
                   15121: 
                   15122: codetitles - reference to array of titles of components in institutional codes (official courses).
                   15123: 
                   15124: 
                   15125: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   15126: 
                   15127: 
                   15128: Side Effects: None
                   15129: 
                   15130: =cut
                   15131: 
                   15132: 
                   15133: sub search_courses {
                   15134:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
                   15135:     my (%courses,%showcourses,$cloner);
                   15136:     if (($filter->{'ownerfilter'} ne '') ||
                   15137:         ($filter->{'ownerdomfilter'} ne '')) {
                   15138:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   15139:                                        $filter->{'ownerdomfilter'};
                   15140:     }
                   15141:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   15142:         if (!$filter->{$item}) {
                   15143:             $filter->{$item}='.';
                   15144:         }
                   15145:     }
                   15146:     my $now = time;
                   15147:     my $timefilter =
                   15148:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   15149:     my ($createdbefore,$createdafter);
                   15150:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   15151:         $createdbefore = $now;
                   15152:         $createdafter = $now-$filter->{'createdfilter'};
                   15153:     }
                   15154:     my ($instcodefilter,$regexpok);
                   15155:     if ($numtitles) {
                   15156:         if ($env{'form.official'} eq 'on') {
                   15157:             $instcodefilter =
                   15158:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15159:             $regexpok = 1;
                   15160:         } elsif ($env{'form.official'} eq 'off') {
                   15161:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15162:             unless ($instcodefilter eq '') {
                   15163:                 $regexpok = -1;
                   15164:             }
                   15165:         }
                   15166:     } else {
                   15167:         $instcodefilter = $filter->{'instcodefilter'};
                   15168:     }
                   15169:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   15170:     if ($type eq '') { $type = '.'; }
                   15171: 
                   15172:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   15173:         $cloner = $cloneruname.':'.$clonerudom;
                   15174:     }
                   15175:     %courses = &Apache::lonnet::courseiddump($dom,
                   15176:                                              $filter->{'descriptfilter'},
                   15177:                                              $timefilter,
                   15178:                                              $instcodefilter,
                   15179:                                              $filter->{'combownerfilter'},
                   15180:                                              $filter->{'coursefilter'},
                   15181:                                              undef,undef,$type,$regexpok,undef,undef,
                   15182:                                              undef,undef,$cloner,$env{'form.cc_clone'},
                   15183:                                              $filter->{'cloneableonly'},
                   15184:                                              $createdbefore,$createdafter,undef,
                   15185:                                              $domcloner);
                   15186:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   15187:         my $ccrole;
                   15188:         if ($type eq 'Community') {
                   15189:             $ccrole = 'co';
                   15190:         } else {
                   15191:             $ccrole = 'cc';
                   15192:         }
                   15193:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   15194:                                                      $filter->{'persondomfilter'},
                   15195:                                                      'userroles',undef,
                   15196:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   15197:                                                      $dom);
                   15198:         foreach my $role (keys(%rolehash)) {
                   15199:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   15200:             my $cid = $cdom.'_'.$cnum;
                   15201:             if (exists($courses{$cid})) {
                   15202:                 if (ref($courses{$cid}) eq 'HASH') {
                   15203:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   15204:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                   15205:                             push (@{$courses{$cid}{roles}},$courserole);
                   15206:                         }
                   15207:                     } else {
                   15208:                         $courses{$cid}{roles} = [$courserole];
                   15209:                     }
                   15210:                     $showcourses{$cid} = $courses{$cid};
                   15211:                 }
                   15212:             }
                   15213:         }
                   15214:         %courses = %showcourses;
                   15215:     }
                   15216:     return %courses;
                   15217: }
                   15218: 
                   15219: 
                   15220: =pod
                   15221: 
                   15222: =back
                   15223: 
                   15224: =cut
                   15225: 
                   15226: 
1.1075.2.11  raeburn  15227: sub update_content_constraints {
                   15228:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15229:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   15230:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   15231:     my %checkresponsetypes;
                   15232:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   15233:         my ($item,$name,$value) = split(/:/,$key);
                   15234:         if ($item eq 'resourcetag') {
                   15235:             if ($name eq 'responsetype') {
                   15236:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   15237:             }
                   15238:         }
                   15239:     }
                   15240:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15241:     if (defined($navmap)) {
                   15242:         my %allresponses;
                   15243:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   15244:             my %responses = $res->responseTypes();
                   15245:             foreach my $key (keys(%responses)) {
                   15246:                 next unless(exists($checkresponsetypes{$key}));
                   15247:                 $allresponses{$key} += $responses{$key};
                   15248:             }
                   15249:         }
                   15250:         foreach my $key (keys(%allresponses)) {
                   15251:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   15252:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   15253:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   15254:             }
                   15255:         }
                   15256:         undef($navmap);
                   15257:     }
                   15258:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   15259:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   15260:     }
                   15261:     return;
                   15262: }
                   15263: 
1.1075.2.27  raeburn  15264: sub allmaps_incourse {
                   15265:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15266:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   15267:         $cid = $env{'request.course.id'};
                   15268:         $cdom = $env{'course.'.$cid.'.domain'};
                   15269:         $cnum = $env{'course.'.$cid.'.num'};
                   15270:         $chome = $env{'course.'.$cid.'.home'};
                   15271:     }
                   15272:     my %allmaps = ();
                   15273:     my $lastchange =
                   15274:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   15275:     if ($lastchange > $env{'request.course.tied'}) {
                   15276:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   15277:         unless ($ferr) {
                   15278:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   15279:         }
                   15280:     }
                   15281:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15282:     if (defined($navmap)) {
                   15283:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   15284:             $allmaps{$res->src()} = 1;
                   15285:         }
                   15286:     }
                   15287:     return \%allmaps;
                   15288: }
                   15289: 
1.1075.2.11  raeburn  15290: sub parse_supplemental_title {
                   15291:     my ($title) = @_;
                   15292: 
                   15293:     my ($foldertitle,$renametitle);
                   15294:     if ($title =~ /&amp;&amp;&amp;/) {
                   15295:         $title = &HTML::Entites::decode($title);
                   15296:     }
                   15297:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   15298:         $renametitle=$4;
                   15299:         my ($time,$uname,$udom) = ($1,$2,$3);
                   15300:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   15301:         my $name =  &plainname($uname,$udom);
                   15302:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   15303:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   15304:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   15305:             $name.': <br />'.$foldertitle;
                   15306:     }
                   15307:     if (wantarray) {
                   15308:         return ($title,$foldertitle,$renametitle);
                   15309:     }
                   15310:     return $title;
                   15311: }
                   15312: 
1.1075.2.43  raeburn  15313: sub recurse_supplemental {
                   15314:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   15315:     if ($suppmap) {
                   15316:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   15317:         if ($fatal) {
                   15318:             $errors ++;
                   15319:         } else {
                   15320:             if ($#LONCAPA::map::resources > 0) {
                   15321:                 foreach my $res (@LONCAPA::map::resources) {
                   15322:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   15323:                     if (($src ne '') && ($status eq 'res')) {
1.1075.2.46  raeburn  15324:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   15325:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43  raeburn  15326:                         } else {
                   15327:                             $numfiles ++;
                   15328:                         }
                   15329:                     }
                   15330:                 }
                   15331:             }
                   15332:         }
                   15333:     }
                   15334:     return ($numfiles,$errors);
                   15335: }
                   15336: 
1.1075.2.18  raeburn  15337: sub symb_to_docspath {
                   15338:     my ($symb) = @_;
                   15339:     return unless ($symb);
                   15340:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   15341:     if ($resurl=~/\.(sequence|page)$/) {
                   15342:         $mapurl=$resurl;
                   15343:     } elsif ($resurl eq 'adm/navmaps') {
                   15344:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   15345:     }
                   15346:     my $mapresobj;
                   15347:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15348:     if (ref($navmap)) {
                   15349:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   15350:     }
                   15351:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   15352:     my $type=$2;
                   15353:     my $path;
                   15354:     if (ref($mapresobj)) {
                   15355:         my $pcslist = $mapresobj->map_hierarchy();
                   15356:         if ($pcslist ne '') {
                   15357:             foreach my $pc (split(/,/,$pcslist)) {
                   15358:                 next if ($pc <= 1);
                   15359:                 my $res = $navmap->getByMapPc($pc);
                   15360:                 if (ref($res)) {
                   15361:                     my $thisurl = $res->src();
                   15362:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   15363:                     my $thistitle = $res->title();
                   15364:                     $path .= '&'.
                   15365:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46  raeburn  15366:                              &escape($thistitle).
1.1075.2.18  raeburn  15367:                              ':'.$res->randompick().
                   15368:                              ':'.$res->randomout().
                   15369:                              ':'.$res->encrypted().
                   15370:                              ':'.$res->randomorder().
                   15371:                              ':'.$res->is_page();
                   15372:                 }
                   15373:             }
                   15374:         }
                   15375:         $path =~ s/^\&//;
                   15376:         my $maptitle = $mapresobj->title();
                   15377:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15378:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15379:         }
                   15380:         $path .= (($path ne '')? '&' : '').
                   15381:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15382:                  &escape($maptitle).
1.1075.2.18  raeburn  15383:                  ':'.$mapresobj->randompick().
                   15384:                  ':'.$mapresobj->randomout().
                   15385:                  ':'.$mapresobj->encrypted().
                   15386:                  ':'.$mapresobj->randomorder().
                   15387:                  ':'.$mapresobj->is_page();
                   15388:     } else {
                   15389:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   15390:         my $ispage = (($type eq 'page')? 1 : '');
                   15391:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15392:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15393:         }
                   15394:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15395:                 &escape($maptitle).':::::'.$ispage;
1.1075.2.18  raeburn  15396:     }
                   15397:     unless ($mapurl eq 'default') {
                   15398:         $path = 'default&'.
1.1075.2.46  raeburn  15399:                 &escape('Main Content').
1.1075.2.18  raeburn  15400:                 ':::::&'.$path;
                   15401:     }
                   15402:     return $path;
                   15403: }
                   15404: 
1.1075.2.14  raeburn  15405: sub captcha_display {
                   15406:     my ($context,$lonhost) = @_;
                   15407:     my ($output,$error);
                   15408:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   15409:     if ($captcha eq 'original') {
                   15410:         $output = &create_captcha();
                   15411:         unless ($output) {
                   15412:             $error = 'captcha';
                   15413:         }
                   15414:     } elsif ($captcha eq 'recaptcha') {
                   15415:         $output = &create_recaptcha($pubkey);
                   15416:         unless ($output) {
                   15417:             $error = 'recaptcha';
                   15418:         }
                   15419:     }
1.1075.2.66  raeburn  15420:     return ($output,$error,$captcha);
1.1075.2.14  raeburn  15421: }
                   15422: 
                   15423: sub captcha_response {
                   15424:     my ($context,$lonhost) = @_;
                   15425:     my ($captcha_chk,$captcha_error);
                   15426:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   15427:     if ($captcha eq 'original') {
                   15428:         ($captcha_chk,$captcha_error) = &check_captcha();
                   15429:     } elsif ($captcha eq 'recaptcha') {
                   15430:         $captcha_chk = &check_recaptcha($privkey);
                   15431:     } else {
                   15432:         $captcha_chk = 1;
                   15433:     }
                   15434:     return ($captcha_chk,$captcha_error);
                   15435: }
                   15436: 
                   15437: sub get_captcha_config {
                   15438:     my ($context,$lonhost) = @_;
                   15439:     my ($captcha,$pubkey,$privkey,$hashtocheck);
                   15440:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   15441:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   15442:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   15443:     if ($context eq 'usercreation') {
                   15444:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   15445:         if (ref($domconfig{$context}) eq 'HASH') {
                   15446:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   15447:             if (ref($hashtocheck) eq 'HASH') {
                   15448:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   15449:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   15450:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   15451:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   15452:                     }
                   15453:                     if ($privkey && $pubkey) {
                   15454:                         $captcha = 'recaptcha';
                   15455:                     } else {
                   15456:                         $captcha = 'original';
                   15457:                     }
                   15458:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   15459:                     $captcha = 'original';
                   15460:                 }
                   15461:             }
                   15462:         } else {
                   15463:             $captcha = 'captcha';
                   15464:         }
                   15465:     } elsif ($context eq 'login') {
                   15466:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   15467:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   15468:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   15469:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   15470:             if ($privkey && $pubkey) {
                   15471:                 $captcha = 'recaptcha';
                   15472:             } else {
                   15473:                 $captcha = 'original';
                   15474:             }
                   15475:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   15476:             $captcha = 'original';
                   15477:         }
                   15478:     }
                   15479:     return ($captcha,$pubkey,$privkey);
                   15480: }
                   15481: 
                   15482: sub create_captcha {
                   15483:     my %captcha_params = &captcha_settings();
                   15484:     my ($output,$maxtries,$tries) = ('',10,0);
                   15485:     while ($tries < $maxtries) {
                   15486:         $tries ++;
                   15487:         my $captcha = Authen::Captcha->new (
                   15488:                                            output_folder => $captcha_params{'output_dir'},
                   15489:                                            data_folder   => $captcha_params{'db_dir'},
                   15490:                                           );
                   15491:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   15492: 
                   15493:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   15494:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   15495:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1075.2.66  raeburn  15496:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   15497:                       '<br />'.
                   15498:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14  raeburn  15499:             last;
                   15500:         }
                   15501:     }
                   15502:     return $output;
                   15503: }
                   15504: 
                   15505: sub captcha_settings {
                   15506:     my %captcha_params = (
                   15507:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   15508:                            www_output_dir => "/captchaspool",
                   15509:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   15510:                            numchars       => '5',
                   15511:                          );
                   15512:     return %captcha_params;
                   15513: }
                   15514: 
                   15515: sub check_captcha {
                   15516:     my ($captcha_chk,$captcha_error);
                   15517:     my $code = $env{'form.code'};
                   15518:     my $md5sum = $env{'form.crypt'};
                   15519:     my %captcha_params = &captcha_settings();
                   15520:     my $captcha = Authen::Captcha->new(
                   15521:                       output_folder => $captcha_params{'output_dir'},
                   15522:                       data_folder   => $captcha_params{'db_dir'},
                   15523:                   );
1.1075.2.26  raeburn  15524:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14  raeburn  15525:     my %captcha_hash = (
                   15526:                         0       => 'Code not checked (file error)',
                   15527:                        -1      => 'Failed: code expired',
                   15528:                        -2      => 'Failed: invalid code (not in database)',
                   15529:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   15530:     );
                   15531:     if ($captcha_chk != 1) {
                   15532:         $captcha_error = $captcha_hash{$captcha_chk}
                   15533:     }
                   15534:     return ($captcha_chk,$captcha_error);
                   15535: }
                   15536: 
                   15537: sub create_recaptcha {
                   15538:     my ($pubkey) = @_;
1.1075.2.51  raeburn  15539:     my $use_ssl;
                   15540:     if ($ENV{'SERVER_PORT'} == 443) {
                   15541:         $use_ssl = 1;
                   15542:     }
1.1075.2.14  raeburn  15543:     my $captcha = Captcha::reCAPTCHA->new;
                   15544:     return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51  raeburn  15545:            $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.14  raeburn  15546:            &mt('If either word is hard to read, [_1] will replace them.',
1.1075.2.39  raeburn  15547:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14  raeburn  15548:            '<br /><br />';
                   15549: }
                   15550: 
                   15551: sub check_recaptcha {
                   15552:     my ($privkey) = @_;
                   15553:     my $captcha_chk;
                   15554:     my $captcha = Captcha::reCAPTCHA->new;
                   15555:     my $captcha_result =
                   15556:         $captcha->check_answer(
                   15557:                                 $privkey,
                   15558:                                 $ENV{'REMOTE_ADDR'},
                   15559:                                 $env{'form.recaptcha_challenge_field'},
                   15560:                                 $env{'form.recaptcha_response_field'},
                   15561:                               );
                   15562:     if ($captcha_result->{is_valid}) {
                   15563:         $captcha_chk = 1;
                   15564:     }
                   15565:     return $captcha_chk;
                   15566: }
                   15567: 
1.1075.2.64  raeburn  15568: sub emailusername_info {
1.1075.2.67  raeburn  15569:     my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1075.2.64  raeburn  15570:     my %titles = &Apache::lonlocal::texthash (
                   15571:                      lastname      => 'Last Name',
                   15572:                      firstname     => 'First Name',
                   15573:                      institution   => 'School/college/university',
                   15574:                      location      => "School's city, state/province, country",
                   15575:                      web           => "School's web address",
                   15576:                      officialemail => 'E-mail address at institution (if different)',
                   15577:                  );
                   15578:     return (\@fields,\%titles);
                   15579: }
                   15580: 
1.1075.2.56  raeburn  15581: sub cleanup_html {
                   15582:     my ($incoming) = @_;
                   15583:     my $outgoing;
                   15584:     if ($incoming ne '') {
                   15585:         $outgoing = $incoming;
                   15586:         $outgoing =~ s/;/&#059;/g;
                   15587:         $outgoing =~ s/\#/&#035;/g;
                   15588:         $outgoing =~ s/\&/&#038;/g;
                   15589:         $outgoing =~ s/</&#060;/g;
                   15590:         $outgoing =~ s/>/&#062;/g;
                   15591:         $outgoing =~ s/\(/&#040/g;
                   15592:         $outgoing =~ s/\)/&#041;/g;
                   15593:         $outgoing =~ s/"/&#034;/g;
                   15594:         $outgoing =~ s/'/&#039;/g;
                   15595:         $outgoing =~ s/\$/&#036;/g;
                   15596:         $outgoing =~ s{/}{&#047;}g;
                   15597:         $outgoing =~ s/=/&#061;/g;
                   15598:         $outgoing =~ s/\\/&#092;/g
                   15599:     }
                   15600:     return $outgoing;
                   15601: }
                   15602: 
1.1075.2.74  raeburn  15603: # Checks for critical messages and returns a redirect url if one exists.
                   15604: # $interval indicates how often to check for messages.
                   15605: sub critical_redirect {
                   15606:     my ($interval) = @_;
                   15607:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
                   15608:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                   15609:                                         $env{'user.name'});
                   15610:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
                   15611:         my $redirecturl;
                   15612:         if ($what[0]) {
                   15613:             if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   15614:                 $redirecturl='/adm/email?critical=display';
                   15615:                 my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   15616:                 return (1, $url);
                   15617:             }
                   15618:         }
                   15619:     }
                   15620:     return ();
                   15621: }
                   15622: 
1.1075.2.64  raeburn  15623: # Use:
                   15624: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   15625: #
                   15626: ##################################################
                   15627: #          password associated functions         #
                   15628: ##################################################
                   15629: sub des_keys {
                   15630:     # Make a new key for DES encryption.
                   15631:     # Each key has two parts which are returned separately.
                   15632:     # Please note:  Each key must be passed through the &hex function
                   15633:     # before it is output to the web browser.  The hex versions cannot
                   15634:     # be used to decrypt.
                   15635:     my @hexstr=('0','1','2','3','4','5','6','7',
                   15636:                 '8','9','a','b','c','d','e','f');
                   15637:     my $lkey='';
                   15638:     for (0..7) {
                   15639:         $lkey.=$hexstr[rand(15)];
                   15640:     }
                   15641:     my $ukey='';
                   15642:     for (0..7) {
                   15643:         $ukey.=$hexstr[rand(15)];
                   15644:     }
                   15645:     return ($lkey,$ukey);
                   15646: }
                   15647: 
                   15648: sub des_decrypt {
                   15649:     my ($key,$cyphertext) = @_;
                   15650:     my $keybin=pack("H16",$key);
                   15651:     my $cypher;
                   15652:     if ($Crypt::DES::VERSION>=2.03) {
                   15653:         $cypher=new Crypt::DES $keybin;
                   15654:     } else {
                   15655:         $cypher=new DES $keybin;
                   15656:     }
                   15657:     my $plaintext=
                   15658:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
                   15659:     $plaintext.=
                   15660:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
                   15661:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
                   15662:     return $plaintext;
                   15663: }
                   15664: 
1.112     bowersj2 15665: 1;
                   15666: __END__;
1.41      ng       15667: 

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