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

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.84! raeburn     4: # $Id: loncommon.pm,v 1.1075.2.83 2014/12/21 16:42:38 raeburn Exp $
1.10      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.1       albertel   28: 
                     29: # Makes a table out of the previous attempts
1.2       albertel   30: # Inputs result_from_symbread, user, domain, course_id
1.16      harris41   31: # Reads in non-network-related .tab files
1.1       albertel   32: 
1.35      matthew    33: # POD header:
                     34: 
1.45      matthew    35: =pod
                     36: 
1.35      matthew    37: =head1 NAME
                     38: 
                     39: Apache::loncommon - pile of common routines
                     40: 
                     41: =head1 SYNOPSIS
                     42: 
1.112     bowersj2   43: Common routines for manipulating connections, student answers,
                     44:     domains, common Javascript fragments, etc.
1.35      matthew    45: 
1.112     bowersj2   46: =head1 OVERVIEW
1.35      matthew    47: 
1.112     bowersj2   48: A collection of commonly used subroutines that don't have a natural
                     49: home anywhere else. This collection helps remove
1.35      matthew    50: redundancy from other modules and increase efficiency of memory usage.
                     51: 
                     52: =cut 
                     53: 
                     54: # End of POD header
1.1       albertel   55: package Apache::loncommon;
                     56: 
                     57: use strict;
1.258     albertel   58: use Apache::lonnet;
1.46      matthew    59: use GDBM_File;
1.51      www        60: use POSIX qw(strftime mktime);
1.82      www        61: use Apache::lonmenu();
1.498     albertel   62: use Apache::lonenc();
1.117     www        63: use Apache::lonlocal;
1.685     tempelho   64: use Apache::lonnet();
1.139     matthew    65: use HTML::Entities;
1.334     albertel   66: use Apache::lonhtmlcommon();
                     67: use Apache::loncoursedata();
1.344     albertel   68: use Apache::lontexconvert();
1.444     albertel   69: use Apache::lonclonecourse();
1.1075.2.25  raeburn    70: use Apache::lonuserutils();
1.1075.2.27  raeburn    71: use Apache::lonuserstate();
1.1075.2.69  raeburn    72: use Apache::courseclassifier();
1.479     albertel   73: use LONCAPA qw(:DEFAULT :match);
1.657     raeburn    74: use DateTime::TimeZone;
1.687     raeburn    75: use DateTime::Locale::Catalog;
1.1075.2.14  raeburn    76: use Authen::Captcha;
                     77: use Captcha::reCAPTCHA;
1.1075.2.64  raeburn    78: use Crypt::DES;
                     79: use DynaLoader; # for Crypt::DES version
1.117     www        80: 
1.517     raeburn    81: # ---------------------------------------------- Designs
                     82: use vars qw(%defaultdesign);
                     83: 
1.22      www        84: my $readit;
                     85: 
1.517     raeburn    86: 
1.157     matthew    87: ##
                     88: ## Global Variables
                     89: ##
1.46      matthew    90: 
1.643     foxr       91: 
                     92: # ----------------------------------------------- SSI with retries:
                     93: #
                     94: 
                     95: =pod
                     96: 
1.648     raeburn    97: =head1 Server Side include with retries:
1.643     foxr       98: 
                     99: =over 4
                    100: 
1.648     raeburn   101: =item * &ssi_with_retries(resource,retries form)
1.643     foxr      102: 
                    103: Performs an ssi with some number of retries.  Retries continue either
                    104: until the result is ok or until the retry count supplied by the
                    105: caller is exhausted.  
                    106: 
                    107: Inputs:
1.648     raeburn   108: 
                    109: =over 4
                    110: 
1.643     foxr      111: resource   - Identifies the resource to insert.
1.648     raeburn   112: 
1.643     foxr      113: retries    - Count of the number of retries allowed.
1.648     raeburn   114: 
1.643     foxr      115: form       - Hash that identifies the rendering options.
                    116: 
1.648     raeburn   117: =back
                    118: 
                    119: Returns:
                    120: 
                    121: =over 4
                    122: 
1.643     foxr      123: content    - The content of the response.  If retries were exhausted this is empty.
1.648     raeburn   124: 
1.643     foxr      125: response   - The response from the last attempt (which may or may not have been successful.
                    126: 
1.648     raeburn   127: =back
                    128: 
                    129: =back
                    130: 
1.643     foxr      131: =cut
                    132: 
                    133: sub ssi_with_retries {
                    134:     my ($resource, $retries, %form) = @_;
                    135: 
                    136: 
                    137:     my $ok = 0;			# True if we got a good response.
                    138:     my $content;
                    139:     my $response;
                    140: 
                    141:     # Try to get the ssi done. within the retries count:
                    142: 
                    143:     do {
                    144: 	($content, $response) = &Apache::lonnet::ssi($resource, %form);
                    145: 	$ok      = $response->is_success;
1.650     www       146:         if (!$ok) {
                    147:             &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
                    148:         }
1.643     foxr      149: 	$retries--;
                    150:     } while (!$ok && ($retries > 0));
                    151: 
                    152:     if (!$ok) {
                    153: 	$content = '';		# On error return an empty content.
                    154:     }
                    155:     return ($content, $response);
                    156: 
                    157: }
                    158: 
                    159: 
                    160: 
1.20      www       161: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12      harris41  162: my %language;
1.124     www       163: my %supported_language;
1.1048    foxr      164: my %latex_language;		# For choosing hyphenation in <transl..>
                    165: my %latex_language_bykey;	# for choosing hyphenation from metadata
1.12      harris41  166: my %cprtag;
1.192     taceyjo1  167: my %scprtag;
1.351     www       168: my %fe; my %fd; my %fm;
1.41      ng        169: my %category_extensions;
1.12      harris41  170: 
1.46      matthew   171: # ---------------------------------------------- Thesaurus variables
1.144     matthew   172: #
                    173: # %Keywords:
                    174: #      A hash used by &keyword to determine if a word is considered a keyword.
                    175: # $thesaurus_db_file 
                    176: #      Scalar containing the full path to the thesaurus database.
1.46      matthew   177: 
                    178: my %Keywords;
                    179: my $thesaurus_db_file;
                    180: 
1.144     matthew   181: #
                    182: # Initialize values from language.tab, copyright.tab, filetypes.tab,
                    183: # thesaurus.tab, and filecategories.tab.
                    184: #
1.18      www       185: BEGIN {
1.46      matthew   186:     # Variable initialization
                    187:     $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
                    188:     #
1.22      www       189:     unless ($readit) {
1.12      harris41  190: # ------------------------------------------------------------------- languages
                    191:     {
1.158     raeburn   192:         my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    193:                                    '/language.tab';
                    194:         if ( open(my $fh,"<$langtabfile") ) {
1.356     albertel  195:             while (my $line = <$fh>) {
                    196:                 next if ($line=~/^\#/);
                    197:                 chomp($line);
1.1048    foxr      198:                 my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158     raeburn   199:                 $language{$key}=$val.' - '.$enc;
                    200:                 if ($sup) {
                    201:                     $supported_language{$key}=$sup;
                    202:                 }
1.1048    foxr      203: 		if ($latex) {
                    204: 		    $latex_language_bykey{$key} = $latex;
                    205: 		    $latex_language{$two} = $latex;
                    206: 		}
1.158     raeburn   207:             }
                    208:             close($fh);
                    209:         }
1.12      harris41  210:     }
                    211: # ------------------------------------------------------------------ copyrights
                    212:     {
1.158     raeburn   213:         my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    214:                                   '/copyright.tab';
                    215:         if ( open (my $fh,"<$copyrightfile") ) {
1.356     albertel  216:             while (my $line = <$fh>) {
                    217:                 next if ($line=~/^\#/);
                    218:                 chomp($line);
                    219:                 my ($key,$val)=(split(/\s+/,$line,2));
1.158     raeburn   220:                 $cprtag{$key}=$val;
                    221:             }
                    222:             close($fh);
                    223:         }
1.12      harris41  224:     }
1.351     www       225: # ----------------------------------------------------------- source copyrights
1.192     taceyjo1  226:     {
                    227:         my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
                    228:                                   '/source_copyright.tab';
                    229:         if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356     albertel  230:             while (my $line = <$fh>) {
                    231:                 next if ($line =~ /^\#/);
                    232:                 chomp($line);
                    233:                 my ($key,$val)=(split(/\s+/,$line,2));
1.192     taceyjo1  234:                 $scprtag{$key}=$val;
                    235:             }
                    236:             close($fh);
                    237:         }
                    238:     }
1.63      www       239: 
1.517     raeburn   240: # -------------------------------------------------------------- default domain designs
1.63      www       241:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517     raeburn   242:     my $designfile = $designdir.'/default.tab';
                    243:     if ( open (my $fh,"<$designfile") ) {
                    244:         while (my $line = <$fh>) {
                    245:             next if ($line =~ /^\#/);
                    246:             chomp($line);
                    247:             my ($key,$val)=(split(/\=/,$line));
                    248:             if ($val) { $defaultdesign{$key}=$val; }
                    249:         }
                    250:         close($fh);
1.63      www       251:     }
                    252: 
1.15      harris41  253: # ------------------------------------------------------------- file categories
                    254:     {
1.158     raeburn   255:         my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    256:                                   '/filecategories.tab';
                    257:         if ( open (my $fh,"<$categoryfile") ) {
1.356     albertel  258: 	    while (my $line = <$fh>) {
                    259: 		next if ($line =~ /^\#/);
                    260: 		chomp($line);
                    261:                 my ($extension,$category)=(split(/\s+/,$line,2));
1.158     raeburn   262:                 push @{$category_extensions{lc($category)}},$extension;
                    263:             }
                    264:             close($fh);
                    265:         }
                    266: 
1.15      harris41  267:     }
1.12      harris41  268: # ------------------------------------------------------------------ file types
                    269:     {
1.158     raeburn   270:         my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
                    271:                '/filetypes.tab';
                    272:         if ( open (my $fh,"<$typesfile") ) {
1.356     albertel  273:             while (my $line = <$fh>) {
                    274: 		next if ($line =~ /^\#/);
                    275: 		chomp($line);
                    276:                 my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158     raeburn   277:                 if ($descr ne '') {
                    278:                     $fe{$ending}=lc($emb);
                    279:                     $fd{$ending}=$descr;
1.351     www       280:                     if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158     raeburn   281:                 }
                    282:             }
                    283:             close($fh);
                    284:         }
1.12      harris41  285:     }
1.22      www       286:     &Apache::lonnet::logthis(
1.705     tempelho  287:              "<span style='color:yellow;'>INFO: Read file types</span>");
1.22      www       288:     $readit=1;
1.46      matthew   289:     }  # end of unless($readit) 
1.32      matthew   290:     
                    291: }
1.112     bowersj2  292: 
1.42      matthew   293: ###############################################################
                    294: ##           HTML and Javascript Helper Functions            ##
                    295: ###############################################################
                    296: 
                    297: =pod 
                    298: 
1.112     bowersj2  299: =head1 HTML and Javascript Functions
1.42      matthew   300: 
1.112     bowersj2  301: =over 4
                    302: 
1.648     raeburn   303: =item * &browser_and_searcher_javascript()
1.112     bowersj2  304: 
                    305: X<browsing, javascript>X<searching, javascript>Returns a string
                    306: containing javascript with two functions, C<openbrowser> and
                    307: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
                    308: tags.
1.42      matthew   309: 
1.648     raeburn   310: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42      matthew   311: 
                    312: inputs: formname, elementname, only, omit
                    313: 
                    314: formname and elementname indicate the name of the html form and name of
                    315: the element that the results of the browsing selection are to be placed in. 
                    316: 
                    317: Specifying 'only' will restrict the browser to displaying only files
1.185     www       318: with the given extension.  Can be a comma separated list.
1.42      matthew   319: 
                    320: Specifying 'omit' will restrict the browser to NOT displaying files
1.185     www       321: with the given extension.  Can be a comma separated list.
1.42      matthew   322: 
1.648     raeburn   323: =item * &opensearcher(formname,elementname) [javascript]
1.42      matthew   324: 
                    325: Inputs: formname, elementname
                    326: 
                    327: formname and elementname specify the name of the html form and the name
                    328: of the element the selection from the search results will be placed in.
1.542     raeburn   329: 
1.42      matthew   330: =cut
                    331: 
                    332: sub browser_and_searcher_javascript {
1.199     albertel  333:     my ($mode)=@_;
                    334:     if (!defined($mode)) { $mode='edit'; }
1.453     albertel  335:     my $resurl=&escape_single(&lastresurl());
1.42      matthew   336:     return <<END;
1.219     albertel  337: // <!-- BEGIN LON-CAPA Internal
1.50      matthew   338:     var editbrowser = null;
1.135     albertel  339:     function openbrowser(formname,elementname,only,omit,titleelement) {
1.170     www       340:         var url = '$resurl/?';
1.42      matthew   341:         if (editbrowser == null) {
                    342:             url += 'launch=1&';
                    343:         }
                    344:         url += 'catalogmode=interactive&';
1.199     albertel  345:         url += 'mode=$mode&';
1.611     albertel  346:         url += 'inhibitmenu=yes&';
1.42      matthew   347:         url += 'form=' + formname + '&';
                    348:         if (only != null) {
                    349:             url += 'only=' + only + '&';
1.217     albertel  350:         } else {
                    351:             url += 'only=&';
                    352: 	}
1.42      matthew   353:         if (omit != null) {
                    354:             url += 'omit=' + omit + '&';
1.217     albertel  355:         } else {
                    356:             url += 'omit=&';
                    357: 	}
1.135     albertel  358:         if (titleelement != null) {
                    359:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  360:         } else {
                    361: 	    url += 'titleelement=&';
                    362: 	}
1.42      matthew   363:         url += 'element=' + elementname + '';
                    364:         var title = 'Browser';
1.435     albertel  365:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   366:         options += ',width=700,height=600';
                    367:         editbrowser = open(url,title,options,'1');
                    368:         editbrowser.focus();
                    369:     }
                    370:     var editsearcher;
1.135     albertel  371:     function opensearcher(formname,elementname,titleelement) {
1.42      matthew   372:         var url = '/adm/searchcat?';
                    373:         if (editsearcher == null) {
                    374:             url += 'launch=1&';
                    375:         }
                    376:         url += 'catalogmode=interactive&';
1.199     albertel  377:         url += 'mode=$mode&';
1.42      matthew   378:         url += 'form=' + formname + '&';
1.135     albertel  379:         if (titleelement != null) {
                    380:             url += 'titleelement=' + titleelement + '&';
1.217     albertel  381:         } else {
                    382: 	    url += 'titleelement=&';
                    383: 	}
1.42      matthew   384:         url += 'element=' + elementname + '';
                    385:         var title = 'Search';
1.435     albertel  386:         var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42      matthew   387:         options += ',width=700,height=600';
                    388:         editsearcher = open(url,title,options,'1');
                    389:         editsearcher.focus();
                    390:     }
1.219     albertel  391: // END LON-CAPA Internal -->
1.42      matthew   392: END
1.170     www       393: }
                    394: 
                    395: sub lastresurl {
1.258     albertel  396:     if ($env{'environment.lastresurl'}) {
                    397: 	return $env{'environment.lastresurl'}
1.170     www       398:     } else {
                    399: 	return '/res';
                    400:     }
                    401: }
                    402: 
                    403: sub storeresurl {
                    404:     my $resurl=&Apache::lonnet::clutter(shift);
                    405:     unless ($resurl=~/^\/res/) { return 0; }
                    406:     $resurl=~s/\/$//;
                    407:     &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646     raeburn   408:     &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170     www       409:     return 1;
1.42      matthew   410: }
                    411: 
1.74      www       412: sub studentbrowser_javascript {
1.111     www       413:    unless (
1.258     albertel  414:             (($env{'request.course.id'}) && 
1.302     albertel  415:              (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    416: 	      || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    417: 					  '/'.$env{'request.course.sec'})
                    418: 	      ))
1.258     albertel  419:          || ($env{'request.role'}=~/^(au|dc|su)/)
1.111     www       420:           ) { return ''; }  
1.74      www       421:    return (<<'ENDSTDBRW');
1.776     bisitz    422: <script type="text/javascript" language="Javascript">
1.824     bisitz    423: // <![CDATA[
1.74      www       424:     var stdeditbrowser;
1.999     www       425:     function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74      www       426:         var url = '/adm/pickstudent?';
                    427:         var filter;
1.558     albertel  428: 	if (!ignorefilter) {
                    429: 	    eval('filter=document.'+formname+'.'+uname+'.value;');
                    430: 	}
1.74      www       431:         if (filter != null) {
                    432:            if (filter != '') {
                    433:                url += 'filter='+filter+'&';
                    434: 	   }
                    435:         }
                    436:         url += 'form=' + formname + '&unameelement='+uname+
1.999     www       437:                                     '&udomelement='+udom+
                    438:                                     '&clicker='+clicker;
1.111     www       439: 	if (roleflag) { url+="&roles=1"; }
1.793     raeburn   440:         if (courseadvonly) { url+="&courseadvonly=1"; }
1.102     www       441:         var title = 'Student_Browser';
1.74      www       442:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    443:         options += ',width=700,height=600';
                    444:         stdeditbrowser = open(url,title,options,'1');
                    445:         stdeditbrowser.focus();
                    446:     }
1.824     bisitz    447: // ]]>
1.74      www       448: </script>
                    449: ENDSTDBRW
                    450: }
1.42      matthew   451: 
1.1003    www       452: sub resourcebrowser_javascript {
                    453:    unless ($env{'request.course.id'}) { return ''; }
1.1004    www       454:    return (<<'ENDRESBRW');
1.1003    www       455: <script type="text/javascript" language="Javascript">
                    456: // <![CDATA[
                    457:     var reseditbrowser;
1.1004    www       458:     function openresbrowser(formname,reslink) {
1.1005    www       459:         var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003    www       460:         var title = 'Resource_Browser';
                    461:         var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005    www       462:         options += ',width=700,height=500';
1.1004    www       463:         reseditbrowser = open(url,title,options,'1');
                    464:         reseditbrowser.focus();
1.1003    www       465:     }
                    466: // ]]>
                    467: </script>
1.1004    www       468: ENDRESBRW
1.1003    www       469: }
                    470: 
1.74      www       471: sub selectstudent_link {
1.999     www       472:    my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
                    473:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    474:                       &Apache::lonhtmlcommon::entity_encode($unameele)."','".
                    475:                       &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258     albertel  476:    if ($env{'request.course.id'}) {  
1.302     albertel  477:        if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
                    478: 	   && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
                    479: 					'/'.$env{'request.course.sec'})) {
1.111     www       480: 	   return '';
                    481:        }
1.999     www       482:        $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793     raeburn   483:        if ($courseadvonly)  {
                    484:            $callargs .= ",'',1,1";
                    485:        }
                    486:        return '<span class="LC_nobreak">'.
                    487:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    488:               &mt('Select User').'</a></span>';
1.74      www       489:    }
1.258     albertel  490:    if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012    www       491:        $callargs .= ",'',1"; 
1.793     raeburn   492:        return '<span class="LC_nobreak">'.
                    493:               '<a href="javascript:openstdbrowser('.$callargs.');">'.
                    494:               &mt('Select User').'</a></span>';
1.111     www       495:    }
                    496:    return '';
1.91      www       497: }
                    498: 
1.1004    www       499: sub selectresource_link {
                    500:    my ($form,$reslink,$arg)=@_;
                    501:    
                    502:    my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
                    503:                       &Apache::lonhtmlcommon::entity_encode($reslink)."'";
                    504:    unless ($env{'request.course.id'}) { return $arg; }
                    505:    return '<span class="LC_nobreak">'.
                    506:               '<a href="javascript:openresbrowser('.$callargs.');">'.
                    507:               $arg.'</a></span>';
                    508: }
                    509: 
                    510: 
                    511: 
1.653     raeburn   512: sub authorbrowser_javascript {
                    513:     return <<"ENDAUTHORBRW";
1.776     bisitz    514: <script type="text/javascript" language="JavaScript">
1.824     bisitz    515: // <![CDATA[
1.653     raeburn   516: var stdeditbrowser;
                    517: 
                    518: function openauthorbrowser(formname,udom) {
                    519:     var url = '/adm/pickauthor?';
                    520:     url += 'form='+formname+'&roledom='+udom;
                    521:     var title = 'Author_Browser';
                    522:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    523:     options += ',width=700,height=600';
                    524:     stdeditbrowser = open(url,title,options,'1');
                    525:     stdeditbrowser.focus();
                    526: }
                    527: 
1.824     bisitz    528: // ]]>
1.653     raeburn   529: </script>
                    530: ENDAUTHORBRW
                    531: }
                    532: 
1.91      www       533: sub coursebrowser_javascript {
1.1075.2.31  raeburn   534:     my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
                    535:         $credits_element) = @_;
1.932     raeburn   536:     my $wintitle = 'Course_Browser';
1.931     raeburn   537:     if ($crstype eq 'Community') {
1.932     raeburn   538:         $wintitle = 'Community_Browser';
1.909     raeburn   539:     }
1.876     raeburn   540:     my $id_functions = &javascript_index_functions();
                    541:     my $output = '
1.776     bisitz    542: <script type="text/javascript" language="JavaScript">
1.824     bisitz    543: // <![CDATA[
1.468     raeburn   544:     var stdeditbrowser;'."\n";
1.876     raeburn   545: 
                    546:     $output .= <<"ENDSTDBRW";
1.909     raeburn   547:     function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91      www       548:         var url = '/adm/pickcourse?';
1.895     raeburn   549:         var formid = getFormIdByName(formname);
1.876     raeburn   550:         var domainfilter = getDomainFromSelectbox(formname,udom);
1.128     albertel  551:         if (domainfilter != null) {
                    552:            if (domainfilter != '') {
                    553:                url += 'domainfilter='+domainfilter+'&';
                    554: 	   }
                    555:         }
1.91      www       556:         url += 'form=' + formname + '&cnumelement='+uname+
1.187     albertel  557: 	                            '&cdomelement='+udom+
                    558:                                     '&cnameelement='+desc;
1.468     raeburn   559:         if (extra_element !=null && extra_element != '') {
1.594     raeburn   560:             if (formname == 'rolechoice' || formname == 'studentform') {
1.468     raeburn   561:                 url += '&roleelement='+extra_element;
                    562:                 if (domainfilter == null || domainfilter == '') {
                    563:                     url += '&domainfilter='+extra_element;
                    564:                 }
1.234     raeburn   565:             }
1.468     raeburn   566:             else {
                    567:                 if (formname == 'portform') {
                    568:                     url += '&setroles='+extra_element;
1.800     raeburn   569:                 } else {
                    570:                     if (formname == 'rules') {
                    571:                         url += '&fixeddom='+extra_element; 
                    572:                     }
1.468     raeburn   573:                 }
                    574:             }     
1.230     raeburn   575:         }
1.909     raeburn   576:         if (type != null && type != '') {
                    577:             url += '&type='+type;
                    578:         }
                    579:         if (type_elem != null && type_elem != '') {
                    580:             url += '&typeelement='+type_elem;
                    581:         }
1.872     raeburn   582:         if (formname == 'ccrs') {
                    583:             var ownername = document.forms[formid].ccuname.value;
                    584:             var ownerdom =  document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
                    585:             url += '&cloner='+ownername+':'+ownerdom;
                    586:         }
1.293     raeburn   587:         if (multflag !=null && multflag != '') {
                    588:             url += '&multiple='+multflag;
                    589:         }
1.909     raeburn   590:         var title = '$wintitle';
1.91      www       591:         var options = 'scrollbars=1,resizable=1,menubar=0';
                    592:         options += ',width=700,height=600';
                    593:         stdeditbrowser = open(url,title,options,'1');
                    594:         stdeditbrowser.focus();
                    595:     }
1.876     raeburn   596: $id_functions
                    597: ENDSTDBRW
1.1075.2.31  raeburn   598:     if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
                    599:         $output .= &setsec_javascript($sec_element,$formname,$role_element,
                    600:                                       $credits_element);
1.876     raeburn   601:     }
                    602:     $output .= '
                    603: // ]]>
                    604: </script>';
                    605:     return $output;
                    606: }
                    607: 
                    608: sub javascript_index_functions {
                    609:     return <<"ENDJS";
                    610: 
                    611: function getFormIdByName(formname) {
                    612:     for (var i=0;i<document.forms.length;i++) {
                    613:         if (document.forms[i].name == formname) {
                    614:             return i;
                    615:         }
                    616:     }
                    617:     return -1;
                    618: }
                    619: 
                    620: function getIndexByName(formid,item) {
                    621:     for (var i=0;i<document.forms[formid].elements.length;i++) {
                    622:         if (document.forms[formid].elements[i].name == item) {
                    623:             return i;
                    624:         }
                    625:     }
                    626:     return -1;
                    627: }
1.468     raeburn   628: 
1.876     raeburn   629: function getDomainFromSelectbox(formname,udom) {
                    630:     var userdom;
                    631:     var formid = getFormIdByName(formname);
                    632:     if (formid > -1) {
                    633:         var domid = getIndexByName(formid,udom);
                    634:         if (domid > -1) {
                    635:             if (document.forms[formid].elements[domid].type == 'select-one') {
                    636:                 userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
                    637:             }
                    638:             if (document.forms[formid].elements[domid].type == 'hidden') {
                    639:                 userdom=document.forms[formid].elements[domid].value;
1.468     raeburn   640:             }
                    641:         }
                    642:     }
1.876     raeburn   643:     return userdom;
                    644: }
                    645: 
                    646: ENDJS
1.468     raeburn   647: 
1.876     raeburn   648: }
                    649: 
1.1017    raeburn   650: sub javascript_array_indexof {
1.1018    raeburn   651:     return <<ENDJS;
1.1017    raeburn   652: <script type="text/javascript" language="JavaScript">
                    653: // <![CDATA[
                    654: 
                    655: if (!Array.prototype.indexOf) {
                    656:     Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
                    657:         "use strict";
                    658:         if (this === void 0 || this === null) {
                    659:             throw new TypeError();
                    660:         }
                    661:         var t = Object(this);
                    662:         var len = t.length >>> 0;
                    663:         if (len === 0) {
                    664:             return -1;
                    665:         }
                    666:         var n = 0;
                    667:         if (arguments.length > 0) {
                    668:             n = Number(arguments[1]);
                    669:             if (n !== n) { // shortcut for verifying if it's NaN
                    670:                 n = 0;
                    671:             } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
                    672:                 n = (n > 0 || -1) * Math.floor(Math.abs(n));
                    673:             }
                    674:         }
                    675:         if (n >= len) {
                    676:             return -1;
                    677:         }
                    678:         var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
                    679:         for (; k < len; k++) {
                    680:             if (k in t && t[k] === searchElement) {
                    681:                 return k;
                    682:             }
                    683:         }
                    684:         return -1;
                    685:     }
                    686: }
                    687: 
                    688: // ]]>
                    689: </script>
                    690: 
                    691: ENDJS
                    692: 
                    693: }
                    694: 
1.876     raeburn   695: sub userbrowser_javascript {
                    696:     my $id_functions = &javascript_index_functions();
                    697:     return <<"ENDUSERBRW";
                    698: 
1.888     raeburn   699: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876     raeburn   700:     var url = '/adm/pickuser?';
                    701:     var userdom = getDomainFromSelectbox(formname,udom);
                    702:     if (userdom != null) {
                    703:        if (userdom != '') {
                    704:            url += 'srchdom='+userdom+'&';
                    705:        }
                    706:     }
                    707:     url += 'form=' + formname + '&unameelement='+uname+
                    708:                                 '&udomelement='+udom+
                    709:                                 '&ulastelement='+ulast+
                    710:                                 '&ufirstelement='+ufirst+
                    711:                                 '&uemailelement='+uemail+
1.881     raeburn   712:                                 '&hideudomelement='+hideudom+
                    713:                                 '&coursedom='+crsdom;
1.888     raeburn   714:     if ((caller != null) && (caller != undefined)) {
                    715:         url += '&caller='+caller;
                    716:     }
1.876     raeburn   717:     var title = 'User_Browser';
                    718:     var options = 'scrollbars=1,resizable=1,menubar=0';
                    719:     options += ',width=700,height=600';
                    720:     var stdeditbrowser = open(url,title,options,'1');
                    721:     stdeditbrowser.focus();
                    722: }
                    723: 
1.888     raeburn   724: function fix_domain (formname,udom,origdom,uname) {
1.876     raeburn   725:     var formid = getFormIdByName(formname);
                    726:     if (formid > -1) {
1.888     raeburn   727:         var unameid = getIndexByName(formid,uname);
1.876     raeburn   728:         var domid = getIndexByName(formid,udom);
                    729:         var hidedomid = getIndexByName(formid,origdom);
                    730:         if (hidedomid > -1) {
                    731:             var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888     raeburn   732:             var unameval = document.forms[formid].elements[unameid].value;
                    733:             if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
                    734:                 if (domid > -1) {
                    735:                     var slct = document.forms[formid].elements[domid];
                    736:                     if (slct.type == 'select-one') {
                    737:                         var i;
                    738:                         for (i=0;i<slct.length;i++) {
                    739:                             if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
                    740:                         }
                    741:                     }
                    742:                     if (slct.type == 'hidden') {
                    743:                         slct.value = fixeddom;
1.876     raeburn   744:                     }
                    745:                 }
1.468     raeburn   746:             }
                    747:         }
                    748:     }
1.876     raeburn   749:     return;
                    750: }
                    751: 
                    752: $id_functions
                    753: ENDUSERBRW
1.468     raeburn   754: }
                    755: 
                    756: sub setsec_javascript {
1.1075.2.31  raeburn   757:     my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905     raeburn   758:     my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
                    759:         $communityrolestr);
                    760:     if ($role_element ne '') {
                    761:         my @allroles = ('st','ta','ep','in','ad');
                    762:         foreach my $crstype ('Course','Community') {
                    763:             if ($crstype eq 'Community') {
                    764:                 foreach my $role (@allroles) {
                    765:                     push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
                    766:                 }
                    767:                 push(@communityrolenames,&Apache::lonnet::plaintext('co'));
                    768:             } else {
                    769:                 foreach my $role (@allroles) {
                    770:                     push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
                    771:                 }
                    772:                 push(@courserolenames,&Apache::lonnet::plaintext('cc'));
                    773:             }
                    774:         }
                    775:         $rolestr = '"'.join('","',@allroles).'"';
                    776:         $courserolestr = '"'.join('","',@courserolenames).'"';
                    777:         $communityrolestr = '"'.join('","',@communityrolenames).'"';
                    778:     }
1.468     raeburn   779:     my $setsections = qq|
                    780: function setSect(sectionlist) {
1.629     raeburn   781:     var sectionsArray = new Array();
                    782:     if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
                    783:         sectionsArray = sectionlist.split(",");
                    784:     }
1.468     raeburn   785:     var numSections = sectionsArray.length;
                    786:     document.$formname.$sec_element.length = 0;
                    787:     if (numSections == 0) {
                    788:         document.$formname.$sec_element.multiple=false;
                    789:         document.$formname.$sec_element.size=1;
                    790:         document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
                    791:     } else {
                    792:         if (numSections == 1) {
                    793:             document.$formname.$sec_element.multiple=false;
                    794:             document.$formname.$sec_element.size=1;
                    795:             document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
                    796:             document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
                    797:             document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
                    798:         } else {
                    799:             for (var i=0; i<numSections; i++) {
                    800:                 document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
                    801:             }
                    802:             document.$formname.$sec_element.multiple=true
                    803:             if (numSections < 3) {
                    804:                 document.$formname.$sec_element.size=numSections;
                    805:             } else {
                    806:                 document.$formname.$sec_element.size=3;
                    807:             }
                    808:             document.$formname.$sec_element.options[0].selected = false
                    809:         }
                    810:     }
1.91      www       811: }
1.905     raeburn   812: 
                    813: function setRole(crstype) {
1.468     raeburn   814: |;
1.905     raeburn   815:     if ($role_element eq '') {
                    816:         $setsections .= '    return;
                    817: }
                    818: ';
                    819:     } else {
                    820:         $setsections .= qq|
                    821:     var elementLength = document.$formname.$role_element.length;
                    822:     var allroles = Array($rolestr);
                    823:     var courserolenames = Array($courserolestr);
                    824:     var communityrolenames = Array($communityrolestr);
                    825:     if (elementLength != undefined) {
                    826:         if (document.$formname.$role_element.options[5].value == 'cc') {
                    827:             if (crstype == 'Course') {
                    828:                 return;
                    829:             } else {
                    830:                 allroles[5] = 'co';
                    831:                 for (var i=0; i<6; i++) {
                    832:                     document.$formname.$role_element.options[i].value = allroles[i];
                    833:                     document.$formname.$role_element.options[i].text = communityrolenames[i];
                    834:                 }
                    835:             }
                    836:         } else {
                    837:             if (crstype == 'Community') {
                    838:                 return;
                    839:             } else {
                    840:                 allroles[5] = 'cc';
                    841:                 for (var i=0; i<6; i++) {
                    842:                     document.$formname.$role_element.options[i].value = allroles[i];
                    843:                     document.$formname.$role_element.options[i].text = courserolenames[i];
                    844:                 }
                    845:             }
                    846:         }
                    847:     }
                    848:     return;
                    849: }
                    850: |;
                    851:     }
1.1075.2.31  raeburn   852:     if ($credits_element) {
                    853:         $setsections .= qq|
                    854: function setCredits(defaultcredits) {
                    855:     document.$formname.$credits_element.value = defaultcredits;
                    856:     return;
                    857: }
                    858: |;
                    859:     }
1.468     raeburn   860:     return $setsections;
                    861: }
                    862: 
1.91      www       863: sub selectcourse_link {
1.909     raeburn   864:    my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
                    865:        $typeelement) = @_;
                    866:    my $type = $selecttype;
1.871     raeburn   867:    my $linktext = &mt('Select Course');
                    868:    if ($selecttype eq 'Community') {
1.909     raeburn   869:        $linktext = &mt('Select Community');
1.906     raeburn   870:    } elsif ($selecttype eq 'Course/Community') {
                    871:        $linktext = &mt('Select Course/Community');
1.909     raeburn   872:        $type = '';
1.1019    raeburn   873:    } elsif ($selecttype eq 'Select') {
                    874:        $linktext = &mt('Select');
                    875:        $type = '';
1.871     raeburn   876:    }
1.787     bisitz    877:    return '<span class="LC_nobreak">'
                    878:          ."<a href='"
                    879:          .'javascript:opencrsbrowser("'.$form.'","'.$unameele
                    880:          .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909     raeburn   881:          .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871     raeburn   882:          ."'>".$linktext.'</a>'
1.787     bisitz    883:          .'</span>';
1.74      www       884: }
1.42      matthew   885: 
1.653     raeburn   886: sub selectauthor_link {
                    887:    my ($form,$udom)=@_;
                    888:    return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
                    889:           &mt('Select Author').'</a>';
                    890: }
                    891: 
1.876     raeburn   892: sub selectuser_link {
1.881     raeburn   893:     my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888     raeburn   894:         $coursedom,$linktext,$caller) = @_;
1.876     raeburn   895:     return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888     raeburn   896:            "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881     raeburn   897:            ');">'.$linktext.'</a>';
1.876     raeburn   898: }
                    899: 
1.273     raeburn   900: sub check_uncheck_jscript {
                    901:     my $jscript = <<"ENDSCRT";
                    902: function checkAll(field) {
                    903:     if (field.length > 0) {
                    904:         for (i = 0; i < field.length; i++) {
1.1075.2.14  raeburn   905:             if (!field[i].disabled) {
                    906:                 field[i].checked = true;
                    907:             }
1.273     raeburn   908:         }
                    909:     } else {
1.1075.2.14  raeburn   910:         if (!field.disabled) {
                    911:             field.checked = true;
                    912:         }
1.273     raeburn   913:     }
                    914: }
                    915:  
                    916: function uncheckAll(field) {
                    917:     if (field.length > 0) {
                    918:         for (i = 0; i < field.length; i++) {
                    919:             field[i].checked = false ;
1.543     albertel  920:         }
                    921:     } else {
1.273     raeburn   922:         field.checked = false ;
                    923:     }
                    924: }
                    925: ENDSCRT
                    926:     return $jscript;
                    927: }
                    928: 
1.656     www       929: sub select_timezone {
1.659     raeburn   930:    my ($name,$selected,$onchange,$includeempty)=@_;
                    931:    my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    932:    if ($includeempty) {
                    933:        $output .= '<option value=""';
                    934:        if (($selected eq '') || ($selected eq 'local')) {
                    935:            $output .= ' selected="selected" ';
                    936:        }
                    937:        $output .= '> </option>';
                    938:    }
1.657     raeburn   939:    my @timezones = DateTime::TimeZone->all_names;
                    940:    foreach my $tzone (@timezones) {
                    941:        $output.= '<option value="'.$tzone.'"';
                    942:        if ($tzone eq $selected) {
                    943:            $output.=' selected="selected"';
                    944:        }
                    945:        $output.=">$tzone</option>\n";
1.656     www       946:    }
                    947:    $output.="</select>";
                    948:    return $output;
                    949: }
1.273     raeburn   950: 
1.687     raeburn   951: sub select_datelocale {
                    952:     my ($name,$selected,$onchange,$includeempty)=@_;
                    953:     my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
                    954:     if ($includeempty) {
                    955:         $output .= '<option value=""';
                    956:         if ($selected eq '') {
                    957:             $output .= ' selected="selected" ';
                    958:         }
                    959:         $output .= '> </option>';
                    960:     }
                    961:     my (@possibles,%locale_names);
                    962:     my @locales = DateTime::Locale::Catalog::Locales;
                    963:     foreach my $locale (@locales) {
                    964:         if (ref($locale) eq 'HASH') {
                    965:             my $id = $locale->{'id'};
                    966:             if ($id ne '') {
                    967:                 my $en_terr = $locale->{'en_territory'};
                    968:                 my $native_terr = $locale->{'native_territory'};
1.695     raeburn   969:                 my @languages = &Apache::lonlocal::preferred_languages();
1.687     raeburn   970:                 if (grep(/^en$/,@languages) || !@languages) {
                    971:                     if ($en_terr ne '') {
                    972:                         $locale_names{$id} = '('.$en_terr.')';
                    973:                     } elsif ($native_terr ne '') {
                    974:                         $locale_names{$id} = $native_terr;
                    975:                     }
                    976:                 } else {
                    977:                     if ($native_terr ne '') {
                    978:                         $locale_names{$id} = $native_terr.' ';
                    979:                     } elsif ($en_terr ne '') {
                    980:                         $locale_names{$id} = '('.$en_terr.')';
                    981:                     }
                    982:                 }
                    983:                 push (@possibles,$id);
                    984:             }
                    985:         }
                    986:     }
                    987:     foreach my $item (sort(@possibles)) {
                    988:         $output.= '<option value="'.$item.'"';
                    989:         if ($item eq $selected) {
                    990:             $output.=' selected="selected"';
                    991:         }
                    992:         $output.=">$item";
                    993:         if ($locale_names{$item} ne '') {
                    994:             $output.="  $locale_names{$item}</option>\n";
                    995:         }
                    996:         $output.="</option>\n";
                    997:     }
                    998:     $output.="</select>";
                    999:     return $output;
                   1000: }
                   1001: 
1.792     raeburn  1002: sub select_language {
                   1003:     my ($name,$selected,$includeempty) = @_;
                   1004:     my %langchoices;
                   1005:     if ($includeempty) {
1.1075.2.32  raeburn  1006:         %langchoices = ('' => 'No language preference');
1.792     raeburn  1007:     }
                   1008:     foreach my $id (&languageids()) {
                   1009:         my $code = &supportedlanguagecode($id);
                   1010:         if ($code) {
                   1011:             $langchoices{$code} = &plainlanguagedescription($id);
                   1012:         }
                   1013:     }
1.1075.2.32  raeburn  1014:     %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970     raeburn  1015:     return &select_form($selected,$name,\%langchoices);
1.792     raeburn  1016: }
                   1017: 
1.42      matthew  1018: =pod
1.36      matthew  1019: 
1.648     raeburn  1020: =item * &linked_select_forms(...)
1.36      matthew  1021: 
                   1022: linked_select_forms returns a string containing a <script></script> block
                   1023: and html for two <select> menus.  The select menus will be linked in that
                   1024: changing the value of the first menu will result in new values being placed
                   1025: in the second menu.  The values in the select menu will appear in alphabetical
1.609     raeburn  1026: order unless a defined order is provided.
1.36      matthew  1027: 
                   1028: linked_select_forms takes the following ordered inputs:
                   1029: 
                   1030: =over 4
                   1031: 
1.112     bowersj2 1032: =item * $formname, the name of the <form> tag
1.36      matthew  1033: 
1.112     bowersj2 1034: =item * $middletext, the text which appears between the <select> tags
1.36      matthew  1035: 
1.112     bowersj2 1036: =item * $firstdefault, the default value for the first menu
1.36      matthew  1037: 
1.112     bowersj2 1038: =item * $firstselectname, the name of the first <select> tag
1.36      matthew  1039: 
1.112     bowersj2 1040: =item * $secondselectname, the name of the second <select> tag
1.36      matthew  1041: 
1.112     bowersj2 1042: =item * $hashref, a reference to a hash containing the data for the menus.
1.36      matthew  1043: 
1.609     raeburn  1044: =item * $menuorder, the order of values in the first menu
                   1045: 
1.1075.2.31  raeburn  1046: =item * $onchangefirst, additional javascript call to execute for an onchange
                   1047:         event for the first <select> tag
                   1048: 
                   1049: =item * $onchangesecond, additional javascript call to execute for an onchange
                   1050:         event for the second <select> tag
                   1051: 
1.41      ng       1052: =back 
                   1053: 
1.36      matthew  1054: Below is an example of such a hash.  Only the 'text', 'default', and 
                   1055: 'select2' keys must appear as stated.  keys(%menu) are the possible 
                   1056: values for the first select menu.  The text that coincides with the 
1.41      ng       1057: first menu value is given in $menu{$choice1}->{'text'}.  The values 
1.36      matthew  1058: and text for the second menu are given in the hash pointed to by 
                   1059: $menu{$choice1}->{'select2'}.  
                   1060: 
1.112     bowersj2 1061:  my %menu = ( A1 => { text =>"Choice A1" ,
                   1062:                        default => "B3",
                   1063:                        select2 => { 
                   1064:                            B1 => "Choice B1",
                   1065:                            B2 => "Choice B2",
                   1066:                            B3 => "Choice B3",
                   1067:                            B4 => "Choice B4"
1.609     raeburn  1068:                            },
                   1069:                        order => ['B4','B3','B1','B2'],
1.112     bowersj2 1070:                    },
                   1071:                A2 => { text =>"Choice A2" ,
                   1072:                        default => "C2",
                   1073:                        select2 => { 
                   1074:                            C1 => "Choice C1",
                   1075:                            C2 => "Choice C2",
                   1076:                            C3 => "Choice C3"
1.609     raeburn  1077:                            },
                   1078:                        order => ['C2','C1','C3'],
1.112     bowersj2 1079:                    },
                   1080:                A3 => { text =>"Choice A3" ,
                   1081:                        default => "D6",
                   1082:                        select2 => { 
                   1083:                            D1 => "Choice D1",
                   1084:                            D2 => "Choice D2",
                   1085:                            D3 => "Choice D3",
                   1086:                            D4 => "Choice D4",
                   1087:                            D5 => "Choice D5",
                   1088:                            D6 => "Choice D6",
                   1089:                            D7 => "Choice D7"
1.609     raeburn  1090:                            },
                   1091:                        order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112     bowersj2 1092:                    }
                   1093:                );
1.36      matthew  1094: 
                   1095: =cut
                   1096: 
                   1097: sub linked_select_forms {
                   1098:     my ($formname,
                   1099:         $middletext,
                   1100:         $firstdefault,
                   1101:         $firstselectname,
                   1102:         $secondselectname, 
1.609     raeburn  1103:         $hashref,
                   1104:         $menuorder,
1.1075.2.31  raeburn  1105:         $onchangefirst,
                   1106:         $onchangesecond
1.36      matthew  1107:         ) = @_;
                   1108:     my $second = "document.$formname.$secondselectname";
                   1109:     my $first = "document.$formname.$firstselectname";
                   1110:     # output the javascript to do the changing
                   1111:     my $result = '';
1.776     bisitz   1112:     $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824     bisitz   1113:     $result.="// <![CDATA[\n";
1.36      matthew  1114:     $result.="var select2data = new Object();\n";
                   1115:     $" = '","';
                   1116:     my $debug = '';
                   1117:     foreach my $s1 (sort(keys(%$hashref))) {
                   1118:         $result.="select2data.d_$s1 = new Object();\n";        
                   1119:         $result.="select2data.d_$s1.def = new String('".
                   1120:             $hashref->{$s1}->{'default'}."');\n";
1.609     raeburn  1121:         $result.="select2data.d_$s1.values = new Array(";
1.36      matthew  1122:         my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609     raeburn  1123:         if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
                   1124:             @s2values = @{$hashref->{$s1}->{'order'}};
                   1125:         }
1.36      matthew  1126:         $result.="\"@s2values\");\n";
                   1127:         $result.="select2data.d_$s1.texts = new Array(";        
                   1128:         my @s2texts;
                   1129:         foreach my $value (@s2values) {
                   1130:             push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
                   1131:         }
                   1132:         $result.="\"@s2texts\");\n";
                   1133:     }
                   1134:     $"=' ';
                   1135:     $result.= <<"END";
                   1136: 
                   1137: function select1_changed() {
                   1138:     // Determine new choice
                   1139:     var newvalue = "d_" + $first.value;
                   1140:     // update select2
                   1141:     var values     = select2data[newvalue].values;
                   1142:     var texts      = select2data[newvalue].texts;
                   1143:     var select2def = select2data[newvalue].def;
                   1144:     var i;
                   1145:     // out with the old
                   1146:     for (i = 0; i < $second.options.length; i++) {
                   1147:         $second.options[i] = null;
                   1148:     }
                   1149:     // in with the nuclear
                   1150:     for (i=0;i<values.length; i++) {
                   1151:         $second.options[i] = new Option(values[i]);
1.143     matthew  1152:         $second.options[i].value = values[i];
1.36      matthew  1153:         $second.options[i].text = texts[i];
                   1154:         if (values[i] == select2def) {
                   1155:             $second.options[i].selected = true;
                   1156:         }
                   1157:     }
                   1158: }
1.824     bisitz   1159: // ]]>
1.36      matthew  1160: </script>
                   1161: END
                   1162:     # output the initial values for the selection lists
1.1075.2.31  raeburn  1163:     $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609     raeburn  1164:     my @order = sort(keys(%{$hashref}));
                   1165:     if (ref($menuorder) eq 'ARRAY') {
                   1166:         @order = @{$menuorder};
                   1167:     }
                   1168:     foreach my $value (@order) {
1.36      matthew  1169:         $result.="    <option value=\"$value\" ";
1.253     albertel 1170:         $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119     www      1171:         $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36      matthew  1172:     }
                   1173:     $result .= "</select>\n";
                   1174:     my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
                   1175:     $result .= $middletext;
1.1075.2.31  raeburn  1176:     $result .= "<select size=\"1\" name=\"$secondselectname\"";
                   1177:     if ($onchangesecond) {
                   1178:         $result .= ' onchange="'.$onchangesecond.'"';
                   1179:     }
                   1180:     $result .= ">\n";
1.36      matthew  1181:     my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609     raeburn  1182:     
                   1183:     my @secondorder = sort(keys(%select2));
                   1184:     if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
                   1185:         @secondorder = @{$hashref->{$firstdefault}->{'order'}};
                   1186:     }
                   1187:     foreach my $value (@secondorder) {
1.36      matthew  1188:         $result.="    <option value=\"$value\" ";        
1.253     albertel 1189:         $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119     www      1190:         $result.=">".&mt($select2{$value})."</option>\n";
1.36      matthew  1191:     }
                   1192:     $result .= "</select>\n";
                   1193:     #    return $debug;
                   1194:     return $result;
                   1195: }   #  end of sub linked_select_forms {
                   1196: 
1.45      matthew  1197: =pod
1.44      bowersj2 1198: 
1.973     raeburn  1199: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44      bowersj2 1200: 
1.112     bowersj2 1201: Returns a string corresponding to an HTML link to the given help
                   1202: $topic, where $topic corresponds to the name of a .tex file in
                   1203: /home/httpd/html/adm/help/tex, with underscores replaced by
                   1204: spaces. 
                   1205: 
                   1206: $text will optionally be linked to the same topic, allowing you to
                   1207: link text in addition to the graphic. If you do not want to link
                   1208: text, but wish to specify one of the later parameters, pass an
                   1209: empty string. 
                   1210: 
                   1211: $stayOnPage is a value that will be interpreted as a boolean. If true,
                   1212: the link will not open a new window. If false, the link will open
                   1213: a new window using Javascript. (Default is false.) 
                   1214: 
                   1215: $width and $height are optional numerical parameters that will
                   1216: override the width and height of the popped up window, which may
1.973     raeburn  1217: be useful for certain help topics with big pictures included.
                   1218: 
                   1219: $imgid is the id of the img tag used for the help icon. This may be
                   1220: used in a javascript call to switch the image src.  See 
                   1221: lonhtmlcommon::htmlareaselectactive() for an example.
1.44      bowersj2 1222: 
                   1223: =cut
                   1224: 
                   1225: sub help_open_topic {
1.973     raeburn  1226:     my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48      bowersj2 1227:     $text = "" if (not defined $text);
1.44      bowersj2 1228:     $stayOnPage = 0 if (not defined $stayOnPage);
1.1033    www      1229:     $width = 500 if (not defined $width);
1.44      bowersj2 1230:     $height = 400 if (not defined $height);
                   1231:     my $filename = $topic;
                   1232:     $filename =~ s/ /_/g;
                   1233: 
1.48      bowersj2 1234:     my $template = "";
                   1235:     my $link;
1.572     banghart 1236:     
1.159     www      1237:     $topic=~s/\W/\_/g;
1.44      bowersj2 1238: 
1.572     banghart 1239:     if (!$stayOnPage) {
1.1075.2.50  raeburn  1240:         if ($env{'browser.mobile'}) {
                   1241: 	    $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
                   1242:         } else {
                   1243:             $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1244:         }
1.1037    www      1245:     } elsif ($stayOnPage eq 'popup') {
                   1246:         $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1.572     banghart 1247:     } else {
1.48      bowersj2 1248: 	$link = "/adm/help/${filename}.hlp";
                   1249:     }
                   1250: 
                   1251:     # Add the text
1.755     neumanie 1252:     if ($text ne "") {	
1.763     bisitz   1253: 	$template.='<span class="LC_help_open_topic">'
                   1254:                   .'<a target="_top" href="'.$link.'">'
                   1255:                   .$text.'</a>';
1.48      bowersj2 1256:     }
                   1257: 
1.763     bisitz   1258:     # (Always) Add the graphic
1.179     matthew  1259:     my $title = &mt('Online Help');
1.667     raeburn  1260:     my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973     raeburn  1261:     if ($imgid ne '') {
                   1262:         $imgid = ' id="'.$imgid.'"';
                   1263:     }
1.763     bisitz   1264:     $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
                   1265:               .'<img src="'.$helpicon.'" border="0"'
                   1266:               .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973     raeburn  1267:               .' title="'.$title.'" style="vertical-align:middle;"'.$imgid 
1.763     bisitz   1268:               .' /></a>';
                   1269:     if ($text ne "") {	
                   1270:         $template.='</span>';
                   1271:     }
1.44      bowersj2 1272:     return $template;
                   1273: 
1.106     bowersj2 1274: }
                   1275: 
                   1276: # This is a quicky function for Latex cheatsheet editing, since it 
                   1277: # appears in at least four places
                   1278: sub helpLatexCheatsheet {
1.1037    www      1279:     my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732     raeburn  1280:     my $out;
1.106     bowersj2 1281:     my $addOther = '';
1.732     raeburn  1282:     if ($topic) {
1.1037    www      1283: 	$addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763     bisitz   1284:     }
                   1285:     $out = '<span>' # Start cheatsheet
                   1286: 	  .$addOther
                   1287:           .'<span>'
1.1037    www      1288: 	  .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1289: 	  .'</span> <span>'
1.1037    www      1290: 	  .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763     bisitz   1291: 	  .'</span>';
1.732     raeburn  1292:     unless ($not_author) {
1.763     bisitz   1293:         $out .= ' <span>'
1.1037    www      1294: 	       .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71  raeburn  1295: 	       .'</span> <span>'
1.1075.2.78  raeburn  1296:                .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71  raeburn  1297:                .'</span>';
1.732     raeburn  1298:     }
1.763     bisitz   1299:     $out .= '</span>'; # End cheatsheet
1.732     raeburn  1300:     return $out;
1.172     www      1301: }
                   1302: 
1.430     albertel 1303: sub general_help {
                   1304:     my $helptopic='Student_Intro';
                   1305:     if ($env{'request.role'}=~/^(ca|au)/) {
                   1306: 	$helptopic='Authoring_Intro';
1.907     raeburn  1307:     } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430     albertel 1308: 	$helptopic='Course_Coordination_Intro';
1.672     raeburn  1309:     } elsif ($env{'request.role'}=~/^dc/) {
                   1310:         $helptopic='Domain_Coordination_Intro';
1.430     albertel 1311:     }
                   1312:     return $helptopic;
                   1313: }
                   1314: 
                   1315: sub update_help_link {
                   1316:     my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
                   1317:     my $origurl = $ENV{'REQUEST_URI'};
                   1318:     $origurl=~s|^/~|/priv/|;
                   1319:     my $timestamp = time;
                   1320:     foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
                   1321:         $$datum = &escape($$datum);
                   1322:     }
                   1323: 
                   1324:     my $banner_link = "/adm/helpmenu?page=banner&amp;topic=$topic&amp;component_help=$component_help&amp;faq=$faq&amp;bug=$bug&amp;origurl=$origurl&amp;stamp=$timestamp&amp;stayonpage=$stayOnPage";
                   1325:     my $output .= <<"ENDOUTPUT";
                   1326: <script type="text/javascript">
1.824     bisitz   1327: // <![CDATA[
1.430     albertel 1328: banner_link = '$banner_link';
1.824     bisitz   1329: // ]]>
1.430     albertel 1330: </script>
                   1331: ENDOUTPUT
                   1332:     return $output;
                   1333: }
                   1334: 
                   1335: # now just updates the help link and generates a blue icon
1.193     raeburn  1336: sub help_open_menu {
1.430     albertel 1337:     my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text) 
1.552     banghart 1338: 	= @_;    
1.949     droeschl 1339:     $stayOnPage = 1;
1.430     albertel 1340:     my $output;
                   1341:     if ($component_help) {
                   1342: 	if (!$text) {
                   1343: 	    $output=&help_open_topic($component_help,undef,$stayOnPage,
                   1344: 				       $width,$height);
                   1345: 	} else {
                   1346: 	    my $help_text;
                   1347: 	    $help_text=&unescape($topic);
                   1348: 	    $output='<table><tr><td>'.
                   1349: 		&help_open_topic($component_help,$help_text,$stayOnPage,
                   1350: 				 $width,$height).'</td></tr></table>';
                   1351: 	}
                   1352:     }
                   1353:     my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
                   1354:     return $output.$banner_link;
                   1355: }
                   1356: 
                   1357: sub top_nav_help {
                   1358:     my ($text) = @_;
1.436     albertel 1359:     $text = &mt($text);
1.1075.2.60  raeburn  1360:     my $stay_on_page;
                   1361:     unless ($env{'environment.remote'} eq 'on') {
                   1362:         $stay_on_page = 1;
                   1363:     }
1.1075.2.61  raeburn  1364:     my ($link,$banner_link);
                   1365:     unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
                   1366:         $link = ($stay_on_page) ? "javascript:helpMenu('display')"
                   1367: 	                         : "javascript:helpMenu('open')";
                   1368:         $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
                   1369:     }
1.201     raeburn  1370:     my $title = &mt('Get help');
1.1075.2.61  raeburn  1371:     if ($link) {
                   1372:         return <<"END";
1.436     albertel 1373: $banner_link
1.1075.2.56  raeburn  1374: <a href="$link" title="$title">$text</a>
1.436     albertel 1375: END
1.1075.2.61  raeburn  1376:     } else {
                   1377:         return '&nbsp;'.$text.'&nbsp;';
                   1378:     }
1.436     albertel 1379: }
                   1380: 
                   1381: sub help_menu_js {
1.1075.2.52  raeburn  1382:     my ($httphost) = @_;
1.949     droeschl 1383:     my $stayOnPage = 1;
1.436     albertel 1384:     my $width = 620;
                   1385:     my $height = 600;
1.430     albertel 1386:     my $helptopic=&general_help();
1.1075.2.52  raeburn  1387:     my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261     albertel 1388:     my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331     albertel 1389:     my $start_page =
                   1390:         &Apache::loncommon::start_page('Help Menu', undef,
                   1391: 				       {'frameset'    => 1,
                   1392: 					'js_ready'    => 1,
1.1075.2.52  raeburn  1393:                                         'use_absolute' => $httphost, 
1.331     albertel 1394: 					'add_entries' => {
                   1395: 					    'border' => '0',
1.579     raeburn  1396: 					    'rows'   => "110,*",},});
1.331     albertel 1397:     my $end_page =
                   1398:         &Apache::loncommon::end_page({'frameset' => 1,
                   1399: 				      'js_ready' => 1,});
                   1400: 
1.436     albertel 1401:     my $template .= <<"ENDTEMPLATE";
                   1402: <script type="text/javascript">
1.877     bisitz   1403: // <![CDATA[
1.253     albertel 1404: // <!-- BEGIN LON-CAPA Internal
1.430     albertel 1405: var banner_link = '';
1.243     raeburn  1406: function helpMenu(target) {
                   1407:     var caller = this;
                   1408:     if (target == 'open') {
                   1409:         var newWindow = null;
                   1410:         try {
1.262     albertel 1411:             newWindow =  window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243     raeburn  1412:         }
                   1413:         catch(error) {
                   1414:             writeHelp(caller);
                   1415:             return;
                   1416:         }
                   1417:         if (newWindow) {
                   1418:             caller = newWindow;
                   1419:         }
1.193     raeburn  1420:     }
1.243     raeburn  1421:     writeHelp(caller);
                   1422:     return;
                   1423: }
                   1424: function writeHelp(caller) {
1.1075.2.61  raeburn  1425:     caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
                   1426:     caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
                   1427:     caller.document.close();
                   1428:     caller.focus();
1.193     raeburn  1429: }
1.877     bisitz   1430: // END LON-CAPA Internal -->
1.253     albertel 1431: // ]]>
1.436     albertel 1432: </script>
1.193     raeburn  1433: ENDTEMPLATE
                   1434:     return $template;
                   1435: }
                   1436: 
1.172     www      1437: sub help_open_bug {
                   1438:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1439:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1440:     unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
                   1441:     $text = "" if (not defined $text);
                   1442: 	$stayOnPage=1;
1.184     albertel 1443:     $width = 600 if (not defined $width);
                   1444:     $height = 600 if (not defined $height);
1.172     www      1445: 
                   1446:     $topic=~s/\W+/\+/g;
                   1447:     my $link='';
                   1448:     my $template='';
1.379     albertel 1449:     my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&amp;bug_file_loc='.
                   1450: 	&escape($ENV{'REQUEST_URI'}).'&amp;component='.$topic;
1.172     www      1451:     if (!$stayOnPage)
                   1452:     {
                   1453: 	$link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1454:     }
                   1455:     else
                   1456:     {
                   1457: 	$link = $url;
                   1458:     }
                   1459:     # Add the text
                   1460:     if ($text ne "")
                   1461:     {
                   1462: 	$template .= 
                   1463:   "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1464:   "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172     www      1465:     }
                   1466: 
                   1467:     # Add the graphic
1.179     matthew  1468:     my $title = &mt('Report a Bug');
1.215     albertel 1469:     my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172     www      1470:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1471:  <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172     www      1472: ENDTEMPLATE
                   1473:     if ($text ne '') { $template.='</td></tr></table>' };
                   1474:     return $template;
                   1475: 
                   1476: }
                   1477: 
                   1478: sub help_open_faq {
                   1479:     my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258     albertel 1480:     unless ($env{'user.adv'}) { return ''; }
1.172     www      1481:     unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
                   1482:     $text = "" if (not defined $text);
                   1483: 	$stayOnPage=1;
                   1484:     $width = 350 if (not defined $width);
                   1485:     $height = 400 if (not defined $height);
                   1486: 
                   1487:     $topic=~s/\W+/\+/g;
                   1488:     my $link='';
                   1489:     my $template='';
                   1490:     my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
                   1491:     if (!$stayOnPage)
                   1492:     {
                   1493: 	$link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
                   1494:     }
                   1495:     else
                   1496:     {
                   1497: 	$link = $url;
                   1498:     }
                   1499: 
                   1500:     # Add the text
                   1501:     if ($text ne "")
                   1502:     {
                   1503: 	$template .= 
1.173     www      1504:   "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705     tempelho 1505:   "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172     www      1506:     }
                   1507: 
                   1508:     # Add the graphic
1.179     matthew  1509:     my $title = &mt('View the FAQ');
1.215     albertel 1510:     my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172     www      1511:     $template .= <<"ENDTEMPLATE";
1.436     albertel 1512:  <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172     www      1513: ENDTEMPLATE
                   1514:     if ($text ne '') { $template.='</td></tr></table>' };
                   1515:     return $template;
                   1516: 
1.44      bowersj2 1517: }
1.37      matthew  1518: 
1.180     matthew  1519: ###############################################################
                   1520: ###############################################################
                   1521: 
1.45      matthew  1522: =pod
                   1523: 
1.648     raeburn  1524: =item * &change_content_javascript():
1.256     matthew  1525: 
                   1526: This and the next function allow you to create small sections of an
                   1527: otherwise static HTML page that you can update on the fly with
                   1528: Javascript, even in Netscape 4.
                   1529: 
                   1530: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
                   1531: must be written to the HTML page once. It will prove the Javascript
                   1532: function "change(name, content)". Calling the change function with the
                   1533: name of the section 
                   1534: you want to update, matching the name passed to C<changable_area>, and
                   1535: the new content you want to put in there, will put the content into
                   1536: that area.
                   1537: 
                   1538: B<Note>: Netscape 4 only reserves enough space for the changable area
                   1539: to contain room for the original contents. You need to "make space"
                   1540: for whatever changes you wish to make, and be B<sure> to check your
                   1541: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
                   1542: it's adequate for updating a one-line status display, but little more.
                   1543: This script will set the space to 100% width, so you only need to
                   1544: worry about height in Netscape 4.
                   1545: 
                   1546: Modern browsers are much less limiting, and if you can commit to the
                   1547: user not using Netscape 4, this feature may be used freely with
                   1548: pretty much any HTML.
                   1549: 
                   1550: =cut
                   1551: 
                   1552: sub change_content_javascript {
                   1553:     # If we're on Netscape 4, we need to use Layer-based code
1.258     albertel 1554:     if ($env{'browser.type'} eq 'netscape' &&
                   1555: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1556: 	return (<<NETSCAPE4);
                   1557: 	function change(name, content) {
                   1558: 	    doc = document.layers[name+"___escape"].layers[0].document;
                   1559: 	    doc.open();
                   1560: 	    doc.write(content);
                   1561: 	    doc.close();
                   1562: 	}
                   1563: NETSCAPE4
                   1564:     } else {
                   1565: 	# Otherwise, we need to use semi-standards-compliant code
                   1566: 	# (technically, "innerHTML" isn't standard but the equivalent
                   1567: 	# is really scary, and every useful browser supports it
                   1568: 	return (<<DOMBASED);
                   1569: 	function change(name, content) {
                   1570: 	    element = document.getElementById(name);
                   1571: 	    element.innerHTML = content;
                   1572: 	}
                   1573: DOMBASED
                   1574:     }
                   1575: }
                   1576: 
                   1577: =pod
                   1578: 
1.648     raeburn  1579: =item * &changable_area($name,$origContent):
1.256     matthew  1580: 
                   1581: This provides a "changable area" that can be modified on the fly via
                   1582: the Javascript code provided in C<change_content_javascript>. $name is
                   1583: the name you will use to reference the area later; do not repeat the
                   1584: same name on a given HTML page more then once. $origContent is what
                   1585: the area will originally contain, which can be left blank.
                   1586: 
                   1587: =cut
                   1588: 
                   1589: sub changable_area {
                   1590:     my ($name, $origContent) = @_;
                   1591: 
1.258     albertel 1592:     if ($env{'browser.type'} eq 'netscape' &&
                   1593: 	$env{'browser.version'} =~ /^4\./) {
1.256     matthew  1594: 	# If this is netscape 4, we need to use the Layer tag
                   1595: 	return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
                   1596:     } else {
                   1597: 	return "<span id='$name'>$origContent</span>";
                   1598:     }
                   1599: }
                   1600: 
                   1601: =pod
                   1602: 
1.648     raeburn  1603: =item * &viewport_geometry_js 
1.590     raeburn  1604: 
                   1605: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
                   1606: 
                   1607: =cut
                   1608: 
                   1609: 
                   1610: sub viewport_geometry_js { 
                   1611:     return <<"GEOMETRY";
                   1612: var Geometry = {};
                   1613: function init_geometry() {
                   1614:     if (Geometry.init) { return };
                   1615:     Geometry.init=1;
                   1616:     if (window.innerHeight) {
                   1617:         Geometry.getViewportHeight   = function() { return window.innerHeight; };
                   1618:         Geometry.getViewportWidth   = function() { return window.innerWidth; };
                   1619:         Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
                   1620:         Geometry.getVerticalScroll   = function() { return window.pageYOffset; };
                   1621:     }
                   1622:     else if (document.documentElement && document.documentElement.clientHeight) {
                   1623:         Geometry.getViewportHeight =
                   1624:             function() { return document.documentElement.clientHeight; };
                   1625:         Geometry.getViewportWidth =
                   1626:             function() { return document.documentElement.clientWidth; };
                   1627: 
                   1628:         Geometry.getHorizontalScroll =
                   1629:             function() { return document.documentElement.scrollLeft; };
                   1630:         Geometry.getVerticalScroll =
                   1631:             function() { return document.documentElement.scrollTop; };
                   1632:     }
                   1633:     else if (document.body.clientHeight) {
                   1634:         Geometry.getViewportHeight =
                   1635:             function() { return document.body.clientHeight; };
                   1636:         Geometry.getViewportWidth =
                   1637:             function() { return document.body.clientWidth; };
                   1638:         Geometry.getHorizontalScroll =
                   1639:             function() { return document.body.scrollLeft; };
                   1640:         Geometry.getVerticalScroll =
                   1641:             function() { return document.body.scrollTop; };
                   1642:     }
                   1643: }
                   1644: 
                   1645: GEOMETRY
                   1646: }
                   1647: 
                   1648: =pod
                   1649: 
1.648     raeburn  1650: =item * &viewport_size_js()
1.590     raeburn  1651: 
                   1652: Provides a javascript function to set values of two form elements - width and height (elements are passed in as arguments to the javascript function) to the dimensions of the user's browser window. 
                   1653: 
                   1654: =cut
                   1655: 
                   1656: sub viewport_size_js {
                   1657:     my $geometry = &viewport_geometry_js();
                   1658:     return <<"DIMS";
                   1659: 
                   1660: $geometry
                   1661: 
                   1662: function getViewportDims(width,height) {
                   1663:     init_geometry();
                   1664:     width.value = Geometry.getViewportWidth();
                   1665:     height.value = Geometry.getViewportHeight();
                   1666:     return;
                   1667: }
                   1668: 
                   1669: DIMS
                   1670: }
                   1671: 
                   1672: =pod
                   1673: 
1.648     raeburn  1674: =item * &resize_textarea_js()
1.565     albertel 1675: 
                   1676: emits the needed javascript to resize a textarea to be as big as possible
                   1677: 
                   1678: creates a function resize_textrea that takes two IDs first should be
                   1679: the id of the element to resize, second should be the id of a div that
                   1680: surrounds everything that comes after the textarea, this routine needs
                   1681: to be attached to the <body> for the onload and onresize events.
                   1682: 
1.648     raeburn  1683: =back
1.565     albertel 1684: 
                   1685: =cut
                   1686: 
                   1687: sub resize_textarea_js {
1.590     raeburn  1688:     my $geometry = &viewport_geometry_js();
1.565     albertel 1689:     return <<"RESIZE";
                   1690:     <script type="text/javascript">
1.824     bisitz   1691: // <![CDATA[
1.590     raeburn  1692: $geometry
1.565     albertel 1693: 
1.588     albertel 1694: function getX(element) {
                   1695:     var x = 0;
                   1696:     while (element) {
                   1697: 	x += element.offsetLeft;
                   1698: 	element = element.offsetParent;
                   1699:     }
                   1700:     return x;
                   1701: }
                   1702: function getY(element) {
                   1703:     var y = 0;
                   1704:     while (element) {
                   1705: 	y += element.offsetTop;
                   1706: 	element = element.offsetParent;
                   1707:     }
                   1708:     return y;
                   1709: }
                   1710: 
                   1711: 
1.565     albertel 1712: function resize_textarea(textarea_id,bottom_id) {
                   1713:     init_geometry();
                   1714:     var textarea        = document.getElementById(textarea_id);
                   1715:     //alert(textarea);
                   1716: 
1.588     albertel 1717:     var textarea_top    = getY(textarea);
1.565     albertel 1718:     var textarea_height = textarea.offsetHeight;
                   1719:     var bottom          = document.getElementById(bottom_id);
1.588     albertel 1720:     var bottom_top      = getY(bottom);
1.565     albertel 1721:     var bottom_height   = bottom.offsetHeight;
                   1722:     var window_height   = Geometry.getViewportHeight();
1.588     albertel 1723:     var fudge           = 23;
1.565     albertel 1724:     var new_height      = window_height-fudge-textarea_top-bottom_height;
                   1725:     if (new_height < 300) {
                   1726: 	new_height = 300;
                   1727:     }
                   1728:     textarea.style.height=new_height+'px';
                   1729: }
1.824     bisitz   1730: // ]]>
1.565     albertel 1731: </script>
                   1732: RESIZE
                   1733: 
                   1734: }
                   1735: 
                   1736: =pod
                   1737: 
1.256     matthew  1738: =head1 Excel and CSV file utility routines
                   1739: 
                   1740: =cut
                   1741: 
                   1742: ###############################################################
                   1743: ###############################################################
                   1744: 
                   1745: =pod
                   1746: 
1.1075.2.56  raeburn  1747: =over 4
                   1748: 
1.648     raeburn  1749: =item * &csv_translate($text) 
1.37      matthew  1750: 
1.185     www      1751: Translate $text to allow it to be output as a 'comma separated values' 
1.37      matthew  1752: format.
                   1753: 
                   1754: =cut
                   1755: 
1.180     matthew  1756: ###############################################################
                   1757: ###############################################################
1.37      matthew  1758: sub csv_translate {
                   1759:     my $text = shift;
                   1760:     $text =~ s/\"/\"\"/g;
1.209     albertel 1761:     $text =~ s/\n/ /g;
1.37      matthew  1762:     return $text;
                   1763: }
1.180     matthew  1764: 
                   1765: ###############################################################
                   1766: ###############################################################
                   1767: 
                   1768: =pod
                   1769: 
1.648     raeburn  1770: =item * &define_excel_formats()
1.180     matthew  1771: 
                   1772: Define some commonly used Excel cell formats.
                   1773: 
                   1774: Currently supported formats:
                   1775: 
                   1776: =over 4
                   1777: 
                   1778: =item header
                   1779: 
                   1780: =item bold
                   1781: 
                   1782: =item h1
                   1783: 
                   1784: =item h2
                   1785: 
                   1786: =item h3
                   1787: 
1.256     matthew  1788: =item h4
                   1789: 
                   1790: =item i
                   1791: 
1.180     matthew  1792: =item date
                   1793: 
                   1794: =back
                   1795: 
                   1796: Inputs: $workbook
                   1797: 
                   1798: Returns: $format, a hash reference.
                   1799: 
1.1057    foxr     1800: 
1.180     matthew  1801: =cut
                   1802: 
                   1803: ###############################################################
                   1804: ###############################################################
                   1805: sub define_excel_formats {
                   1806:     my ($workbook) = @_;
                   1807:     my $format;
                   1808:     $format->{'header'} = $workbook->add_format(bold      => 1, 
                   1809:                                                 bottom    => 1,
                   1810:                                                 align     => 'center');
                   1811:     $format->{'bold'} = $workbook->add_format(bold=>1);
                   1812:     $format->{'h1'}   = $workbook->add_format(bold=>1, size=>18);
                   1813:     $format->{'h2'}   = $workbook->add_format(bold=>1, size=>16);
                   1814:     $format->{'h3'}   = $workbook->add_format(bold=>1, size=>14);
1.255     matthew  1815:     $format->{'h4'}   = $workbook->add_format(bold=>1, size=>12);
1.246     matthew  1816:     $format->{'i'}    = $workbook->add_format(italic=>1);
1.180     matthew  1817:     $format->{'date'} = $workbook->add_format(num_format=>
1.207     matthew  1818:                                             'mm/dd/yyyy hh:mm:ss');
1.180     matthew  1819:     return $format;
                   1820: }
                   1821: 
                   1822: ###############################################################
                   1823: ###############################################################
1.113     bowersj2 1824: 
                   1825: =pod
                   1826: 
1.648     raeburn  1827: =item * &create_workbook()
1.255     matthew  1828: 
                   1829: Create an Excel worksheet.  If it fails, output message on the
                   1830: request object and return undefs.
                   1831: 
                   1832: Inputs: Apache request object
                   1833: 
                   1834: Returns (undef) on failure, 
                   1835:     Excel worksheet object, scalar with filename, and formats 
                   1836:     from &Apache::loncommon::define_excel_formats on success
                   1837: 
                   1838: =cut
                   1839: 
                   1840: ###############################################################
                   1841: ###############################################################
                   1842: sub create_workbook {
                   1843:     my ($r) = @_;
                   1844:         #
                   1845:     # Create the excel spreadsheet
                   1846:     my $filename = '/prtspool/'.
1.258     albertel 1847:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255     matthew  1848:         time.'_'.rand(1000000000).'.xls';
                   1849:     my $workbook  = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
                   1850:     if (! defined($workbook)) {
                   1851:         $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928     bisitz   1852:         $r->print(
                   1853:             '<p class="LC_error">'
                   1854:            .&mt('Problems occurred in creating the new Excel file.')
                   1855:            .' '.&mt('This error has been logged.')
                   1856:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1857:            .'</p>'
                   1858:         );
1.255     matthew  1859:         return (undef);
                   1860:     }
                   1861:     #
1.1014    foxr     1862:     $workbook->set_tempdir(LONCAPA::tempdir());
1.255     matthew  1863:     #
                   1864:     my $format = &Apache::loncommon::define_excel_formats($workbook);
                   1865:     return ($workbook,$filename,$format);
                   1866: }
                   1867: 
                   1868: ###############################################################
                   1869: ###############################################################
                   1870: 
                   1871: =pod
                   1872: 
1.648     raeburn  1873: =item * &create_text_file()
1.113     bowersj2 1874: 
1.542     raeburn  1875: Create a file to write to and eventually make available to the user.
1.256     matthew  1876: If file creation fails, outputs an error message on the request object and 
                   1877: return undefs.
1.113     bowersj2 1878: 
1.256     matthew  1879: Inputs: Apache request object, and file suffix
1.113     bowersj2 1880: 
1.256     matthew  1881: Returns (undef) on failure, 
                   1882:     Filehandle and filename on success.
1.113     bowersj2 1883: 
                   1884: =cut
                   1885: 
1.256     matthew  1886: ###############################################################
                   1887: ###############################################################
                   1888: sub create_text_file {
                   1889:     my ($r,$suffix) = @_;
                   1890:     if (! defined($suffix)) { $suffix = 'txt'; };
                   1891:     my $fh;
                   1892:     my $filename = '/prtspool/'.
1.258     albertel 1893:         $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256     matthew  1894:         time.'_'.rand(1000000000).'.'.$suffix;
                   1895:     $fh = Apache::File->new('>/home/httpd'.$filename);
                   1896:     if (! defined($fh)) {
                   1897:         $r->log_error("Couldn't open $filename for output $!");
1.928     bisitz   1898:         $r->print(
                   1899:             '<p class="LC_error">'
                   1900:            .&mt('Problems occurred in creating the output file.')
                   1901:            .' '.&mt('This error has been logged.')
                   1902:            .' '.&mt('Please alert your LON-CAPA administrator.')
                   1903:            .'</p>'
                   1904:         );
1.113     bowersj2 1905:     }
1.256     matthew  1906:     return ($fh,$filename)
1.113     bowersj2 1907: }
                   1908: 
                   1909: 
1.256     matthew  1910: =pod 
1.113     bowersj2 1911: 
                   1912: =back
                   1913: 
                   1914: =cut
1.37      matthew  1915: 
                   1916: ###############################################################
1.33      matthew  1917: ##        Home server <option> list generating code          ##
                   1918: ###############################################################
1.35      matthew  1919: 
1.169     www      1920: # ------------------------------------------
                   1921: 
                   1922: sub domain_select {
                   1923:     my ($name,$value,$multiple)=@_;
                   1924:     my %domains=map { 
1.514     albertel 1925: 	$_ => $_.' '. &Apache::lonnet::domain($_,'description') 
1.512     albertel 1926:     } &Apache::lonnet::all_domains();
1.169     www      1927:     if ($multiple) {
                   1928: 	$domains{''}=&mt('Any domain');
1.550     albertel 1929: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287     albertel 1930: 	return &multiple_select_form($name,$value,4,\%domains);
1.169     www      1931:     } else {
1.550     albertel 1932: 	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970     raeburn  1933: 	return &select_form($name,$value,\%domains);
1.169     www      1934:     }
                   1935: }
                   1936: 
1.282     albertel 1937: #-------------------------------------------
                   1938: 
                   1939: =pod
                   1940: 
1.519     raeburn  1941: =head1 Routines for form select boxes
                   1942: 
                   1943: =over 4
                   1944: 
1.648     raeburn  1945: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282     albertel 1946: 
                   1947: Returns a string containing a <select> element int multiple mode
                   1948: 
                   1949: 
                   1950: Args:
                   1951:   $name - name of the <select> element
1.506     raeburn  1952:   $value - scalar or array ref of values that should already be selected
1.282     albertel 1953:   $size - number of rows long the select element is
1.283     albertel 1954:   $hash - the elements should be 'option' => 'shown text'
1.282     albertel 1955:           (shown text should already have been &mt())
1.506     raeburn  1956:   $order - (optional) array ref of the order to show the elements in
1.283     albertel 1957: 
1.282     albertel 1958: =cut
                   1959: 
                   1960: #-------------------------------------------
1.169     www      1961: sub multiple_select_form {
1.284     albertel 1962:     my ($name,$value,$size,$hash,$order)=@_;
1.169     www      1963:     my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
                   1964:     my $output='';
1.191     matthew  1965:     if (! defined($size)) {
                   1966:         $size = 4;
1.283     albertel 1967:         if (scalar(keys(%$hash))<4) {
                   1968:             $size = scalar(keys(%$hash));
1.191     matthew  1969:         }
                   1970:     }
1.734     bisitz   1971:     $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501     banghart 1972:     my @order;
1.506     raeburn  1973:     if (ref($order) eq 'ARRAY')  {
                   1974:         @order = @{$order};
                   1975:     } else {
                   1976:         @order = sort(keys(%$hash));
1.501     banghart 1977:     }
                   1978:     if (exists($$hash{'select_form_order'})) {
                   1979:         @order = @{$$hash{'select_form_order'}};
                   1980:     }
                   1981:         
1.284     albertel 1982:     foreach my $key (@order) {
1.356     albertel 1983:         $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284     albertel 1984:         $output.='selected="selected" ' if ($selected{$key});
                   1985:         $output.='>'.$hash->{$key}."</option>\n";
1.169     www      1986:     }
                   1987:     $output.="</select>\n";
                   1988:     return $output;
                   1989: }
                   1990: 
1.88      www      1991: #-------------------------------------------
                   1992: 
                   1993: =pod
                   1994: 
1.970     raeburn  1995: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88      www      1996: 
                   1997: Returns a string containing a <select name='$name' size='1'> form to 
1.970     raeburn  1998: allow a user to select options from a ref to a hash containing:
                   1999: option_name => displayed text. An optional $onchange can include
                   2000: a javascript onchange item, e.g., onchange="this.form.submit();"  
                   2001: 
1.88      www      2002: See lonrights.pm for an example invocation and use.
                   2003: 
                   2004: =cut
                   2005: 
                   2006: #-------------------------------------------
                   2007: sub select_form {
1.970     raeburn  2008:     my ($def,$name,$hashref,$onchange) = @_;
                   2009:     return unless (ref($hashref) eq 'HASH');
                   2010:     if ($onchange) {
                   2011:         $onchange = ' onchange="'.$onchange.'"';
                   2012:     }
                   2013:     my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128     albertel 2014:     my @keys;
1.970     raeburn  2015:     if (exists($hashref->{'select_form_order'})) {
                   2016: 	@keys=@{$hashref->{'select_form_order'}};
1.128     albertel 2017:     } else {
1.970     raeburn  2018: 	@keys=sort(keys(%{$hashref}));
1.128     albertel 2019:     }
1.356     albertel 2020:     foreach my $key (@keys) {
                   2021:         $selectform.=
                   2022: 	    '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
                   2023:             ($key eq $def ? 'selected="selected" ' : '').
1.970     raeburn  2024:                 ">".$hashref->{$key}."</option>\n";
1.88      www      2025:     }
                   2026:     $selectform.="</select>";
                   2027:     return $selectform;
                   2028: }
                   2029: 
1.475     www      2030: # For display filters
                   2031: 
                   2032: sub display_filter {
1.1074    raeburn  2033:     my ($context) = @_;
1.475     www      2034:     if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477     www      2035:     if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074    raeburn  2036:     my $phraseinput = 'hidden';
                   2037:     my $includeinput = 'hidden';
                   2038:     my ($checked,$includetypestext);
                   2039:     if ($env{'form.displayfilter'} eq 'containing') {
                   2040:         $phraseinput = 'text'; 
                   2041:         if ($context eq 'parmslog') {
                   2042:             $includeinput = 'checkbox';
                   2043:             if ($env{'form.includetypes'}) {
                   2044:                 $checked = ' checked="checked"';
                   2045:             }
                   2046:             $includetypestext = &mt('Include parameter types');
                   2047:         }
                   2048:     } else {
                   2049:         $includetypestext = '&nbsp;';
                   2050:     }
                   2051:     my ($additional,$secondid,$thirdid);
                   2052:     if ($context eq 'parmslog') {
                   2053:         $additional = 
                   2054:             '<label><input type="'.$includeinput.'" name="includetypes"'. 
                   2055:             $checked.' name="includetypes" value="1" id="includetypes" />'.
                   2056:             '&nbsp;<span id="includetypestext">'.$includetypestext.'</span>'.
                   2057:             '</label>';
                   2058:         $secondid = 'includetypes';
                   2059:         $thirdid = 'includetypestext';
                   2060:     }
                   2061:     my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
                   2062:                                                     '$secondid','$thirdid')";
                   2063:     return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475     www      2064: 			       &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
                   2065: 							   (&mt('all'),10,20,50,100,1000,10000))).
1.714     bisitz   2066: 	   '</label></span> <span class="LC_nobreak">'.
1.1074    raeburn  2067:            &mt('Filter: [_1]',
1.477     www      2068: 	   &select_form($env{'form.displayfilter'},
                   2069: 			'displayfilter',
1.970     raeburn  2070: 			{'currentfolder' => 'Current folder/page',
1.477     www      2071: 			 'containing' => 'Containing phrase',
1.1074    raeburn  2072: 			 'none' => 'None'},$onchange)).'&nbsp;'.
                   2073: 			 '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
                   2074:                          &HTML::Entities::encode($env{'form.containingphrase'}).
                   2075:                          '" />'.$additional;
                   2076: }
                   2077: 
                   2078: sub display_filter_js {
                   2079:     my $includetext = &mt('Include parameter types');
                   2080:     return <<"ENDJS";
                   2081:   
                   2082: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
                   2083:     var firstType = 'hidden';
                   2084:     if (setter.options[setter.selectedIndex].value == 'containing') {
                   2085:         firstType = 'text';
                   2086:     }
                   2087:     firstObject = document.getElementById(firstid);
                   2088:     if (typeof(firstObject) == 'object') {
                   2089:         if (firstObject.type != firstType) {
                   2090:             changeInputType(firstObject,firstType);
                   2091:         }
                   2092:     }
                   2093:     if (context == 'parmslog') {
                   2094:         var secondType = 'hidden';
                   2095:         if (firstType == 'text') {
                   2096:             secondType = 'checkbox';
                   2097:         }
                   2098:         secondObject = document.getElementById(secondid);  
                   2099:         if (typeof(secondObject) == 'object') {
                   2100:             if (secondObject.type != secondType) {
                   2101:                 changeInputType(secondObject,secondType);
                   2102:             }
                   2103:         }
                   2104:         var textItem = document.getElementById(thirdid);
                   2105:         var currtext = textItem.innerHTML;
                   2106:         var newtext;
                   2107:         if (firstType == 'text') {
                   2108:             newtext = '$includetext';
                   2109:         } else {
                   2110:             newtext = '&nbsp;';
                   2111:         }
                   2112:         if (currtext != newtext) {
                   2113:             textItem.innerHTML = newtext;
                   2114:         }
                   2115:     }
                   2116:     return;
                   2117: }
                   2118: 
                   2119: function changeInputType(oldObject,newType) {
                   2120:     var newObject = document.createElement('input');
                   2121:     newObject.type = newType;
                   2122:     if (oldObject.size) {
                   2123:         newObject.size = oldObject.size;
                   2124:     }
                   2125:     if (oldObject.value) {
                   2126:         newObject.value = oldObject.value;
                   2127:     }
                   2128:     if (oldObject.name) {
                   2129:         newObject.name = oldObject.name;
                   2130:     }
                   2131:     if (oldObject.id) {
                   2132:         newObject.id = oldObject.id;
                   2133:     }
                   2134:     oldObject.parentNode.replaceChild(newObject,oldObject);
                   2135:     return;
                   2136: }
                   2137: 
                   2138: ENDJS
1.475     www      2139: }
                   2140: 
1.167     www      2141: sub gradeleveldescription {
                   2142:     my $gradelevel=shift;
                   2143:     my %gradelevels=(0 => 'Not specified',
                   2144: 		     1 => 'Grade 1',
                   2145: 		     2 => 'Grade 2',
                   2146: 		     3 => 'Grade 3',
                   2147: 		     4 => 'Grade 4',
                   2148: 		     5 => 'Grade 5',
                   2149: 		     6 => 'Grade 6',
                   2150: 		     7 => 'Grade 7',
                   2151: 		     8 => 'Grade 8',
                   2152: 		     9 => 'Grade 9',
                   2153: 		     10 => 'Grade 10',
                   2154: 		     11 => 'Grade 11',
                   2155: 		     12 => 'Grade 12',
                   2156: 		     13 => 'Grade 13',
                   2157: 		     14 => '100 Level',
                   2158: 		     15 => '200 Level',
                   2159: 		     16 => '300 Level',
                   2160: 		     17 => '400 Level',
                   2161: 		     18 => 'Graduate Level');
                   2162:     return &mt($gradelevels{$gradelevel});
                   2163: }
                   2164: 
1.163     www      2165: sub select_level_form {
                   2166:     my ($deflevel,$name)=@_;
                   2167:     unless ($deflevel) { $deflevel=0; }
1.167     www      2168:     my $selectform = "<select name=\"$name\" size=\"1\">\n";
                   2169:     for (my $i=0; $i<=18; $i++) {
                   2170:         $selectform.="<option value=\"$i\" ".
1.253     albertel 2171:             ($i==$deflevel ? 'selected="selected" ' : '').
1.167     www      2172:                 ">".&gradeleveldescription($i)."</option>\n";
                   2173:     }
                   2174:     $selectform.="</select>";
                   2175:     return $selectform;
1.163     www      2176: }
1.167     www      2177: 
1.35      matthew  2178: #-------------------------------------------
                   2179: 
1.45      matthew  2180: =pod
                   2181: 
1.1075.2.42  raeburn  2182: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35      matthew  2183: 
                   2184: Returns a string containing a <select name='$name' size='1'> form to 
                   2185: allow a user to select the domain to preform an operation in.  
                   2186: See loncreateuser.pm for an example invocation and use.
                   2187: 
1.90      www      2188: If the $includeempty flag is set, it also includes an empty choice ("no domain
                   2189: selected");
                   2190: 
1.743     raeburn  2191: If the $showdomdesc flag is set, the domain name is followed by the domain description.
                   2192: 
1.910     raeburn  2193: The optional $onchange argument specifies what should occur if the domain selector is changed, e.g., 'this.form.submit()' if the form is to be automatically submitted.
                   2194: 
1.1075.2.36  raeburn  2195: The optional $incdoms is a reference to an array of domains which will be the only available options.
                   2196: 
                   2197: The optional $excdoms is a reference to an array of domains which will be excluded from the available options. 
1.563     raeburn  2198: 
1.35      matthew  2199: =cut
                   2200: 
                   2201: #-------------------------------------------
1.34      matthew  2202: sub select_dom_form {
1.1075.2.36  raeburn  2203:     my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872     raeburn  2204:     if ($onchange) {
1.874     raeburn  2205:         $onchange = ' onchange="'.$onchange.'"';
1.743     raeburn  2206:     }
1.1075.2.36  raeburn  2207:     my (@domains,%exclude);
1.910     raeburn  2208:     if (ref($incdoms) eq 'ARRAY') {
                   2209:         @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
                   2210:     } else {
                   2211:         @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
                   2212:     }
1.90      www      2213:     if ($includeempty) { @domains=('',@domains); }
1.1075.2.36  raeburn  2214:     if (ref($excdoms) eq 'ARRAY') {
                   2215:         map { $exclude{$_} = 1; } @{$excdoms};
                   2216:     }
1.743     raeburn  2217:     my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356     albertel 2218:     foreach my $dom (@domains) {
1.1075.2.36  raeburn  2219:         next if ($exclude{$dom});
1.356     albertel 2220:         $selectdomain.="<option value=\"$dom\" ".
1.563     raeburn  2221:             ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
                   2222:         if ($showdomdesc) {
                   2223:             if ($dom ne '') {
                   2224:                 my $domdesc = &Apache::lonnet::domain($dom,'description');
                   2225:                 if ($domdesc ne '') {
                   2226:                     $selectdomain .= ' ('.$domdesc.')';
                   2227:                 }
                   2228:             } 
                   2229:         }
                   2230:         $selectdomain .= "</option>\n";
1.34      matthew  2231:     }
                   2232:     $selectdomain.="</select>";
                   2233:     return $selectdomain;
                   2234: }
                   2235: 
1.35      matthew  2236: #-------------------------------------------
                   2237: 
1.45      matthew  2238: =pod
                   2239: 
1.648     raeburn  2240: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35      matthew  2241: 
1.586     raeburn  2242: input: 4 arguments (two required, two optional) - 
                   2243:     $domain - domain of new user
                   2244:     $name - name of form element
                   2245:     $default - Value of 'default' causes a default item to be first 
                   2246:                             option, and selected by default. 
                   2247:     $hide - Value of 'hide' causes hiding of the name of the server, 
                   2248:                             if 1 server found, or default, if 0 found.
1.594     raeburn  2249: output: returns 2 items: 
1.586     raeburn  2250: (a) form element which contains either:
                   2251:    (i) <select name="$name">
                   2252:         <option value="$hostid1">$hostid $servers{$hostid}</option>
                   2253:         <option value="$hostid2">$hostid $servers{$hostid}</option>       
                   2254:        </select>
                   2255:        form item if there are multiple library servers in $domain, or
                   2256:    (ii) an <input type="hidden" name="$name" value="$hostid" /> form item 
                   2257:        if there is only one library server in $domain.
                   2258: 
                   2259: (b) number of library servers found.
                   2260: 
                   2261: See loncreateuser.pm for example of use.
1.35      matthew  2262: 
                   2263: =cut
                   2264: 
                   2265: #-------------------------------------------
1.586     raeburn  2266: sub home_server_form_item {
                   2267:     my ($domain,$name,$default,$hide) = @_;
1.513     albertel 2268:     my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586     raeburn  2269:     my $result;
                   2270:     my $numlib = keys(%servers);
                   2271:     if ($numlib > 1) {
                   2272:         $result .= '<select name="'.$name.'" />'."\n";
                   2273:         if ($default) {
1.804     bisitz   2274:             $result .= '<option value="default" selected="selected">'.&mt('default').
1.586     raeburn  2275:                        '</option>'."\n";
                   2276:         }
                   2277:         foreach my $hostid (sort(keys(%servers))) {
                   2278:             $result.= '<option value="'.$hostid.'">'.
                   2279: 	              $hostid.' '.$servers{$hostid}."</option>\n";
                   2280:         }
                   2281:         $result .= '</select>'."\n";
                   2282:     } elsif ($numlib == 1) {
                   2283:         my $hostid;
                   2284:         foreach my $item (keys(%servers)) {
                   2285:             $hostid = $item;
                   2286:         }
                   2287:         $result .= '<input type="hidden" name="'.$name.'" value="'.
                   2288:                    $hostid.'" />';
                   2289:                    if (!$hide) {
                   2290:                        $result .= $hostid.' '.$servers{$hostid};
                   2291:                    }
                   2292:                    $result .= "\n";
                   2293:     } elsif ($default) {
                   2294:         $result .= '<input type="hidden" name="'.$name.
                   2295:                    '" value="default" />';
                   2296:                    if (!$hide) {
                   2297:                        $result .= &mt('default');
                   2298:                    }
                   2299:                    $result .= "\n";
1.33      matthew  2300:     }
1.586     raeburn  2301:     return ($result,$numlib);
1.33      matthew  2302: }
1.112     bowersj2 2303: 
                   2304: =pod
                   2305: 
1.534     albertel 2306: =back 
                   2307: 
1.112     bowersj2 2308: =cut
1.87      matthew  2309: 
                   2310: ###############################################################
1.112     bowersj2 2311: ##                  Decoding User Agent                      ##
1.87      matthew  2312: ###############################################################
                   2313: 
                   2314: =pod
                   2315: 
1.112     bowersj2 2316: =head1 Decoding the User Agent
                   2317: 
                   2318: =over 4
                   2319: 
                   2320: =item * &decode_user_agent()
1.87      matthew  2321: 
                   2322: Inputs: $r
                   2323: 
                   2324: Outputs:
                   2325: 
                   2326: =over 4
                   2327: 
1.112     bowersj2 2328: =item * $httpbrowser
1.87      matthew  2329: 
1.112     bowersj2 2330: =item * $clientbrowser
1.87      matthew  2331: 
1.112     bowersj2 2332: =item * $clientversion
1.87      matthew  2333: 
1.112     bowersj2 2334: =item * $clientmathml
1.87      matthew  2335: 
1.112     bowersj2 2336: =item * $clientunicode
1.87      matthew  2337: 
1.112     bowersj2 2338: =item * $clientos
1.87      matthew  2339: 
1.1075.2.42  raeburn  2340: =item * $clientmobile
                   2341: 
                   2342: =item * $clientinfo
                   2343: 
1.1075.2.77  raeburn  2344: =item * $clientosversion
                   2345: 
1.87      matthew  2346: =back
                   2347: 
1.157     matthew  2348: =back 
                   2349: 
1.87      matthew  2350: =cut
                   2351: 
                   2352: ###############################################################
                   2353: ###############################################################
                   2354: sub decode_user_agent {
1.247     albertel 2355:     my ($r)=@_;
1.87      matthew  2356:     my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
                   2357:     my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
                   2358:     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247     albertel 2359:     if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87      matthew  2360:     my $clientbrowser='unknown';
                   2361:     my $clientversion='0';
                   2362:     my $clientmathml='';
                   2363:     my $clientunicode='0';
1.1075.2.42  raeburn  2364:     my $clientmobile=0;
1.1075.2.77  raeburn  2365:     my $clientosversion='';
1.87      matthew  2366:     for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76  raeburn  2367:         my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87      matthew  2368: 	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
                   2369: 	    $clientbrowser=$bname;
                   2370:             $httpbrowser=~/$vreg/i;
                   2371: 	    $clientversion=$1;
                   2372:             $clientmathml=($clientversion>=$minv);
                   2373:             $clientunicode=($clientversion>=$univ);
                   2374: 	}
                   2375:     }
                   2376:     my $clientos='unknown';
1.1075.2.42  raeburn  2377:     my $clientinfo;
1.87      matthew  2378:     if (($httpbrowser=~/linux/i) ||
                   2379:         ($httpbrowser=~/unix/i) ||
                   2380:         ($httpbrowser=~/ux/i) ||
                   2381:         ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
                   2382:     if (($httpbrowser=~/vax/i) ||
                   2383:         ($httpbrowser=~/vms/i)) { $clientos='vms'; }
                   2384:     if ($httpbrowser=~/next/i) { $clientos='next'; }
                   2385:     if (($httpbrowser=~/mac/i) ||
                   2386:         ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77  raeburn  2387:     if ($httpbrowser=~/win/i) {
                   2388:         $clientos='win';
                   2389:         if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
                   2390:             $clientosversion = $1;
                   2391:         }
                   2392:     }
1.87      matthew  2393:     if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42  raeburn  2394:     if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
                   2395:         $clientmobile=lc($1);
                   2396:     }
                   2397:     if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
                   2398:         $clientinfo = 'firefox-'.$1;
                   2399:     } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
                   2400:         $clientinfo = 'chromeframe-'.$1;
                   2401:     }
1.87      matthew  2402:     return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77  raeburn  2403:             $clientunicode,$clientos,$clientmobile,$clientinfo,
                   2404:             $clientosversion);
1.87      matthew  2405: }
                   2406: 
1.32      matthew  2407: ###############################################################
                   2408: ##    Authentication changing form generation subroutines    ##
                   2409: ###############################################################
                   2410: ##
                   2411: ## All of the authform_xxxxxxx subroutines take their inputs in a
                   2412: ## hash, and have reasonable default values.
                   2413: ##
                   2414: ##    formname = the name given in the <form> tag.
1.35      matthew  2415: #-------------------------------------------
                   2416: 
1.45      matthew  2417: =pod
                   2418: 
1.112     bowersj2 2419: =head1 Authentication Routines
                   2420: 
                   2421: =over 4
                   2422: 
1.648     raeburn  2423: =item * &authform_xxxxxx()
1.35      matthew  2424: 
                   2425: The authform_xxxxxx subroutines provide javascript and html forms which 
                   2426: handle some of the conveniences required for authentication forms.  
                   2427: This is not an optimal method, but it works.  
                   2428: 
                   2429: =over 4
                   2430: 
1.112     bowersj2 2431: =item * authform_header
1.35      matthew  2432: 
1.112     bowersj2 2433: =item * authform_authorwarning
1.35      matthew  2434: 
1.112     bowersj2 2435: =item * authform_nochange
1.35      matthew  2436: 
1.112     bowersj2 2437: =item * authform_kerberos
1.35      matthew  2438: 
1.112     bowersj2 2439: =item * authform_internal
1.35      matthew  2440: 
1.112     bowersj2 2441: =item * authform_filesystem
1.35      matthew  2442: 
                   2443: =back
                   2444: 
1.648     raeburn  2445: See loncreateuser.pm for invocation and use examples.
1.157     matthew  2446: 
1.35      matthew  2447: =cut
                   2448: 
                   2449: #-------------------------------------------
1.32      matthew  2450: sub authform_header{  
                   2451:     my %in = (
                   2452:         formname => 'cu',
1.80      albertel 2453:         kerb_def_dom => '',
1.32      matthew  2454:         @_,
                   2455:     );
                   2456:     $in{'formname'} = 'document.' . $in{'formname'};
                   2457:     my $result='';
1.80      albertel 2458: 
                   2459: #---------------------------------------------- Code for upper case translation
                   2460:     my $Javascript_toUpperCase;
                   2461:     unless ($in{kerb_def_dom}) {
                   2462:         $Javascript_toUpperCase =<<"END";
                   2463:         switch (choice) {
                   2464:            case 'krb': currentform.elements[choicearg].value =
                   2465:                currentform.elements[choicearg].value.toUpperCase();
                   2466:                break;
                   2467:            default:
                   2468:         }
                   2469: END
                   2470:     } else {
                   2471:         $Javascript_toUpperCase = "";
                   2472:     }
                   2473: 
1.165     raeburn  2474:     my $radioval = "'nochange'";
1.591     raeburn  2475:     if (defined($in{'curr_authtype'})) {
                   2476:         if ($in{'curr_authtype'} ne '') {
                   2477:             $radioval = "'".$in{'curr_authtype'}."arg'";
                   2478:         }
1.174     matthew  2479:     }
1.165     raeburn  2480:     my $argfield = 'null';
1.591     raeburn  2481:     if (defined($in{'mode'})) {
1.165     raeburn  2482:         if ($in{'mode'} eq 'modifycourse')  {
1.591     raeburn  2483:             if (defined($in{'curr_autharg'})) {
                   2484:                 if ($in{'curr_autharg'} ne '') {
1.165     raeburn  2485:                     $argfield = "'$in{'curr_autharg'}'";
                   2486:                 }
                   2487:             }
                   2488:         }
                   2489:     }
                   2490: 
1.32      matthew  2491:     $result.=<<"END";
                   2492: var current = new Object();
1.165     raeburn  2493: current.radiovalue = $radioval;
                   2494: current.argfield = $argfield;
1.32      matthew  2495: 
                   2496: function changed_radio(choice,currentform) {
                   2497:     var choicearg = choice + 'arg';
                   2498:     // If a radio button in changed, we need to change the argfield
                   2499:     if (current.radiovalue != choice) {
                   2500:         current.radiovalue = choice;
                   2501:         if (current.argfield != null) {
                   2502:             currentform.elements[current.argfield].value = '';
                   2503:         }
                   2504:         if (choice == 'nochange') {
                   2505:             current.argfield = null;
                   2506:         } else {
                   2507:             current.argfield = choicearg;
                   2508:             switch(choice) {
                   2509:                 case 'krb': 
                   2510:                     currentform.elements[current.argfield].value = 
                   2511:                         "$in{'kerb_def_dom'}";
                   2512:                 break;
                   2513:               default:
                   2514:                 break;
                   2515:             }
                   2516:         }
                   2517:     }
                   2518:     return;
                   2519: }
1.22      www      2520: 
1.32      matthew  2521: function changed_text(choice,currentform) {
                   2522:     var choicearg = choice + 'arg';
                   2523:     if (currentform.elements[choicearg].value !='') {
1.80      albertel 2524:         $Javascript_toUpperCase
1.32      matthew  2525:         // clear old field
                   2526:         if ((current.argfield != choicearg) && (current.argfield != null)) {
                   2527:             currentform.elements[current.argfield].value = '';
                   2528:         }
                   2529:         current.argfield = choicearg;
                   2530:     }
                   2531:     set_auth_radio_buttons(choice,currentform);
                   2532:     return;
1.20      www      2533: }
1.32      matthew  2534: 
                   2535: function set_auth_radio_buttons(newvalue,currentform) {
1.986     raeburn  2536:     var numauthchoices = currentform.login.length;
                   2537:     if (typeof numauthchoices  == "undefined") {
                   2538:         return;
                   2539:     } 
1.32      matthew  2540:     var i=0;
1.986     raeburn  2541:     while (i < numauthchoices) {
1.32      matthew  2542:         if (currentform.login[i].value == newvalue) { break; }
                   2543:         i++;
                   2544:     }
1.986     raeburn  2545:     if (i == numauthchoices) {
1.32      matthew  2546:         return;
                   2547:     }
                   2548:     current.radiovalue = newvalue;
                   2549:     currentform.login[i].checked = true;
                   2550:     return;
                   2551: }
                   2552: END
                   2553:     return $result;
                   2554: }
                   2555: 
1.1075.2.20  raeburn  2556: sub authform_authorwarning {
1.32      matthew  2557:     my $result='';
1.144     matthew  2558:     $result='<i>'.
                   2559:         &mt('As a general rule, only authors or co-authors should be '.
                   2560:             'filesystem authenticated '.
                   2561:             '(which allows access to the server filesystem).')."</i>\n";
1.32      matthew  2562:     return $result;
                   2563: }
                   2564: 
1.1075.2.20  raeburn  2565: sub authform_nochange {
1.32      matthew  2566:     my %in = (
                   2567:               formname => 'document.cu',
                   2568:               kerb_def_dom => 'MSU.EDU',
                   2569:               @_,
                   2570:           );
1.1075.2.20  raeburn  2571:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); 
1.586     raeburn  2572:     my $result;
1.1075.2.20  raeburn  2573:     if (!$authnum) {
                   2574:         $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586     raeburn  2575:     } else {
                   2576:         $result = '<label>'.&mt('[_1] Do not change login data',
                   2577:                   '<input type="radio" name="login" value="nochange" '.
                   2578:                   'checked="checked" onclick="'.
1.281     albertel 2579:             "javascript:changed_radio('nochange',$in{'formname'});".'" />').
                   2580: 	    '</label>';
1.586     raeburn  2581:     }
1.32      matthew  2582:     return $result;
                   2583: }
                   2584: 
1.591     raeburn  2585: sub authform_kerberos {
1.32      matthew  2586:     my %in = (
                   2587:               formname => 'document.cu',
                   2588:               kerb_def_dom => 'MSU.EDU',
1.80      albertel 2589:               kerb_def_auth => 'krb4',
1.32      matthew  2590:               @_,
                   2591:               );
1.586     raeburn  2592:     my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
                   2593:         $autharg,$jscall);
1.1075.2.20  raeburn  2594:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80      albertel 2595:     if ($in{'kerb_def_auth'} eq 'krb5') {
1.772     bisitz   2596:        $check5 = ' checked="checked"';
1.80      albertel 2597:     } else {
1.772     bisitz   2598:        $check4 = ' checked="checked"';
1.80      albertel 2599:     }
1.165     raeburn  2600:     $krbarg = $in{'kerb_def_dom'};
1.591     raeburn  2601:     if (defined($in{'curr_authtype'})) {
                   2602:         if ($in{'curr_authtype'} eq 'krb') {
1.772     bisitz   2603:             $krbcheck = ' checked="checked"';
1.623     raeburn  2604:             if (defined($in{'mode'})) {
                   2605:                 if ($in{'mode'} eq 'modifyuser') {
                   2606:                     $krbcheck = '';
                   2607:                 }
                   2608:             }
1.591     raeburn  2609:             if (defined($in{'curr_kerb_ver'})) {
                   2610:                 if ($in{'curr_krb_ver'} eq '5') {
1.772     bisitz   2611:                     $check5 = ' checked="checked"';
1.591     raeburn  2612:                     $check4 = '';
                   2613:                 } else {
1.772     bisitz   2614:                     $check4 = ' checked="checked"';
1.591     raeburn  2615:                     $check5 = '';
                   2616:                 }
1.586     raeburn  2617:             }
1.591     raeburn  2618:             if (defined($in{'curr_autharg'})) {
1.165     raeburn  2619:                 $krbarg = $in{'curr_autharg'};
                   2620:             }
1.586     raeburn  2621:             if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591     raeburn  2622:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2623:                     $result = 
                   2624:     &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
                   2625:         $in{'curr_autharg'},$krbver);
                   2626:                 } else {
                   2627:                     $result =
                   2628:     &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
                   2629:                 }
                   2630:                 return $result; 
                   2631:             }
                   2632:         }
                   2633:     } else {
                   2634:         if ($authnum == 1) {
1.784     bisitz   2635:             $authtype = '<input type="hidden" name="login" value="krb" />';
1.165     raeburn  2636:         }
                   2637:     }
1.586     raeburn  2638:     if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
                   2639:         return;
1.587     raeburn  2640:     } elsif ($authtype eq '') {
1.591     raeburn  2641:         if (defined($in{'mode'})) {
1.587     raeburn  2642:             if ($in{'mode'} eq 'modifycourse') {
                   2643:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2644:                     $authtype = '<input type="radio" name="login" value="krb" />';
1.587     raeburn  2645:                 }
                   2646:             }
                   2647:         }
1.586     raeburn  2648:     }
                   2649:     $jscall = "javascript:changed_radio('krb',$in{'formname'});";
                   2650:     if ($authtype eq '') {
                   2651:         $authtype = '<input type="radio" name="login" value="krb" '.
                   2652:                     'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
                   2653:                     $krbcheck.' />';
                   2654:     }
                   2655:     if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20  raeburn  2656:         ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586     raeburn  2657:          $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20  raeburn  2658:         (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586     raeburn  2659:          $in{'curr_authtype'} eq 'krb4')) {
                   2660:         $result .= &mt
1.144     matthew  2661:         ('[_1] Kerberos authenticated with domain [_2] '.
1.281     albertel 2662:          '[_3] Version 4 [_4] Version 5 [_5]',
1.586     raeburn  2663:          '<label>'.$authtype,
1.281     albertel 2664:          '</label><input type="text" size="10" name="krbarg" '.
1.165     raeburn  2665:              'value="'.$krbarg.'" '.
1.144     matthew  2666:              'onchange="'.$jscall.'" />',
1.281     albertel 2667:          '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
                   2668:          '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
                   2669: 	 '</label>');
1.586     raeburn  2670:     } elsif ($can_assign{'krb4'}) {
                   2671:         $result .= &mt
                   2672:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2673:          '[_3] Version 4 [_4]',
                   2674:          '<label>'.$authtype,
                   2675:          '</label><input type="text" size="10" name="krbarg" '.
                   2676:              'value="'.$krbarg.'" '.
                   2677:              'onchange="'.$jscall.'" />',
                   2678:          '<label><input type="hidden" name="krbver" value="4" />',
                   2679:          '</label>');
                   2680:     } elsif ($can_assign{'krb5'}) {
                   2681:         $result .= &mt
                   2682:         ('[_1] Kerberos authenticated with domain [_2] '.
                   2683:          '[_3] Version 5 [_4]',
                   2684:          '<label>'.$authtype,
                   2685:          '</label><input type="text" size="10" name="krbarg" '.
                   2686:              'value="'.$krbarg.'" '.
                   2687:              'onchange="'.$jscall.'" />',
                   2688:          '<label><input type="hidden" name="krbver" value="5" />',
                   2689:          '</label>');
                   2690:     }
1.32      matthew  2691:     return $result;
                   2692: }
                   2693: 
1.1075.2.20  raeburn  2694: sub authform_internal {
1.586     raeburn  2695:     my %in = (
1.32      matthew  2696:                 formname => 'document.cu',
                   2697:                 kerb_def_dom => 'MSU.EDU',
                   2698:                 @_,
                   2699:                 );
1.586     raeburn  2700:     my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2701:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2702:     if (defined($in{'curr_authtype'})) {
                   2703:         if ($in{'curr_authtype'} eq 'int') {
1.586     raeburn  2704:             if ($can_assign{'int'}) {
1.772     bisitz   2705:                 $intcheck = 'checked="checked" ';
1.623     raeburn  2706:                 if (defined($in{'mode'})) {
                   2707:                     if ($in{'mode'} eq 'modifyuser') {
                   2708:                         $intcheck = '';
                   2709:                     }
                   2710:                 }
1.591     raeburn  2711:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2712:                     $intarg = $in{'curr_autharg'};
                   2713:                 }
                   2714:             } else {
                   2715:                 $result = &mt('Currently internally authenticated.');
                   2716:                 return $result;
1.165     raeburn  2717:             }
                   2718:         }
1.586     raeburn  2719:     } else {
                   2720:         if ($authnum == 1) {
1.784     bisitz   2721:             $authtype = '<input type="hidden" name="login" value="int" />';
1.586     raeburn  2722:         }
                   2723:     }
                   2724:     if (!$can_assign{'int'}) {
                   2725:         return;
1.587     raeburn  2726:     } elsif ($authtype eq '') {
1.591     raeburn  2727:         if (defined($in{'mode'})) {
1.587     raeburn  2728:             if ($in{'mode'} eq 'modifycourse') {
                   2729:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2730:                     $authtype = '<input type="radio" name="login" value="int" />';
1.587     raeburn  2731:                 }
                   2732:             }
                   2733:         }
1.165     raeburn  2734:     }
1.586     raeburn  2735:     $jscall = "javascript:changed_radio('int',$in{'formname'});";
                   2736:     if ($authtype eq '') {
                   2737:         $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
                   2738:                     ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
                   2739:     }
1.605     bisitz   2740:     $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586     raeburn  2741:                $intarg.'" onchange="'.$jscall.'" />';
                   2742:     $result = &mt
1.144     matthew  2743:         ('[_1] Internally authenticated (with initial password [_2])',
1.586     raeburn  2744:          '<label>'.$authtype,'</label>'.$autharg);
1.824     bisitz   2745:     $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32      matthew  2746:     return $result;
                   2747: }
                   2748: 
1.1075.2.20  raeburn  2749: sub authform_local {
1.32      matthew  2750:     my %in = (
                   2751:               formname => 'document.cu',
                   2752:               kerb_def_dom => 'MSU.EDU',
                   2753:               @_,
                   2754:               );
1.586     raeburn  2755:     my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2756:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2757:     if (defined($in{'curr_authtype'})) {
                   2758:         if ($in{'curr_authtype'} eq 'loc') {
1.586     raeburn  2759:             if ($can_assign{'loc'}) {
1.772     bisitz   2760:                 $loccheck = 'checked="checked" ';
1.623     raeburn  2761:                 if (defined($in{'mode'})) {
                   2762:                     if ($in{'mode'} eq 'modifyuser') {
                   2763:                         $loccheck = '';
                   2764:                     }
                   2765:                 }
1.591     raeburn  2766:                 if (defined($in{'curr_autharg'})) {
1.586     raeburn  2767:                     $locarg = $in{'curr_autharg'};
                   2768:                 }
                   2769:             } else {
                   2770:                 $result = &mt('Currently using local (institutional) authentication.');
                   2771:                 return $result;
1.165     raeburn  2772:             }
                   2773:         }
1.586     raeburn  2774:     } else {
                   2775:         if ($authnum == 1) {
1.784     bisitz   2776:             $authtype = '<input type="hidden" name="login" value="loc" />';
1.586     raeburn  2777:         }
                   2778:     }
                   2779:     if (!$can_assign{'loc'}) {
                   2780:         return;
1.587     raeburn  2781:     } elsif ($authtype eq '') {
1.591     raeburn  2782:         if (defined($in{'mode'})) {
1.587     raeburn  2783:             if ($in{'mode'} eq 'modifycourse') {
                   2784:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2785:                     $authtype = '<input type="radio" name="login" value="loc" />';
1.587     raeburn  2786:                 }
                   2787:             }
                   2788:         }
1.165     raeburn  2789:     }
1.586     raeburn  2790:     $jscall = "javascript:changed_radio('loc',$in{'formname'});";
                   2791:     if ($authtype eq '') {
                   2792:         $authtype = '<input type="radio" name="login" value="loc" '.
                   2793:                     $loccheck.' onchange="'.$jscall.'" onclick="'.
                   2794:                     $jscall.'" />';
                   2795:     }
                   2796:     $autharg = '<input type="text" size="10" name="locarg" value="'.
                   2797:                $locarg.'" onchange="'.$jscall.'" />';
                   2798:     $result = &mt('[_1] Local Authentication with argument [_2]',
                   2799:                   '<label>'.$authtype,'</label>'.$autharg);
1.32      matthew  2800:     return $result;
                   2801: }
                   2802: 
1.1075.2.20  raeburn  2803: sub authform_filesystem {
1.32      matthew  2804:     my %in = (
                   2805:               formname => 'document.cu',
                   2806:               kerb_def_dom => 'MSU.EDU',
                   2807:               @_,
                   2808:               );
1.586     raeburn  2809:     my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20  raeburn  2810:     my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591     raeburn  2811:     if (defined($in{'curr_authtype'})) {
                   2812:         if ($in{'curr_authtype'} eq 'fsys') {
1.586     raeburn  2813:             if ($can_assign{'fsys'}) {
1.772     bisitz   2814:                 $fsyscheck = 'checked="checked" ';
1.623     raeburn  2815:                 if (defined($in{'mode'})) {
                   2816:                     if ($in{'mode'} eq 'modifyuser') {
                   2817:                         $fsyscheck = '';
                   2818:                     }
                   2819:                 }
1.586     raeburn  2820:             } else {
                   2821:                 $result = &mt('Currently Filesystem Authenticated.');
                   2822:                 return $result;
                   2823:             }           
                   2824:         }
                   2825:     } else {
                   2826:         if ($authnum == 1) {
1.784     bisitz   2827:             $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586     raeburn  2828:         }
                   2829:     }
                   2830:     if (!$can_assign{'fsys'}) {
                   2831:         return;
1.587     raeburn  2832:     } elsif ($authtype eq '') {
1.591     raeburn  2833:         if (defined($in{'mode'})) {
1.587     raeburn  2834:             if ($in{'mode'} eq 'modifycourse') {
                   2835:                 if ($authnum == 1) {
1.1075.2.20  raeburn  2836:                     $authtype = '<input type="radio" name="login" value="fsys" />';
1.587     raeburn  2837:                 }
                   2838:             }
                   2839:         }
1.586     raeburn  2840:     }
                   2841:     $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
                   2842:     if ($authtype eq '') {
                   2843:         $authtype = '<input type="radio" name="login" value="fsys" '.
                   2844:                     $fsyscheck.' onchange="'.$jscall.'" onclick="'.
                   2845:                     $jscall.'" />';
                   2846:     }
                   2847:     $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
                   2848:                ' onchange="'.$jscall.'" />';
                   2849:     $result = &mt
1.144     matthew  2850:         ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281     albertel 2851:          '<label><input type="radio" name="login" value="fsys" '.
1.586     raeburn  2852:          $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605     bisitz   2853:          '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144     matthew  2854:                   'onchange="'.$jscall.'" />');
1.32      matthew  2855:     return $result;
                   2856: }
                   2857: 
1.586     raeburn  2858: sub get_assignable_auth {
                   2859:     my ($dom) = @_;
                   2860:     if ($dom eq '') {
                   2861:         $dom = $env{'request.role.domain'};
                   2862:     }
                   2863:     my %can_assign = (
                   2864:                           krb4 => 1,
                   2865:                           krb5 => 1,
                   2866:                           int  => 1,
                   2867:                           loc  => 1,
                   2868:                      );
                   2869:     my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
                   2870:     if (ref($domconfig{'usercreation'}) eq 'HASH') {
                   2871:         if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
                   2872:             my $authhash = $domconfig{'usercreation'}{'authtypes'};
                   2873:             my $context;
                   2874:             if ($env{'request.role'} =~ /^au/) {
                   2875:                 $context = 'author';
                   2876:             } elsif ($env{'request.role'} =~ /^dc/) {
                   2877:                 $context = 'domain';
                   2878:             } elsif ($env{'request.course.id'}) {
                   2879:                 $context = 'course';
                   2880:             }
                   2881:             if ($context) {
                   2882:                 if (ref($authhash->{$context}) eq 'HASH') {
                   2883:                    %can_assign = %{$authhash->{$context}}; 
                   2884:                 }
                   2885:             }
                   2886:         }
                   2887:     }
                   2888:     my $authnum = 0;
                   2889:     foreach my $key (keys(%can_assign)) {
                   2890:         if ($can_assign{$key}) {
                   2891:             $authnum ++;
                   2892:         }
                   2893:     }
                   2894:     if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
                   2895:         $authnum --;
                   2896:     }
                   2897:     return ($authnum,%can_assign);
                   2898: }
                   2899: 
1.80      albertel 2900: ###############################################################
                   2901: ##    Get Kerberos Defaults for Domain                 ##
                   2902: ###############################################################
                   2903: ##
                   2904: ## Returns default kerberos version and an associated argument
                   2905: ## as listed in file domain.tab. If not listed, provides
                   2906: ## appropriate default domain and kerberos version.
                   2907: ##
                   2908: #-------------------------------------------
                   2909: 
                   2910: =pod
                   2911: 
1.648     raeburn  2912: =item * &get_kerberos_defaults()
1.80      albertel 2913: 
                   2914: get_kerberos_defaults($target_domain) returns the default kerberos
1.641     raeburn  2915: version and domain. If not found, it defaults to version 4 and the 
                   2916: domain of the server.
1.80      albertel 2917: 
1.648     raeburn  2918: =over 4
                   2919: 
1.80      albertel 2920: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
                   2921: 
1.648     raeburn  2922: =back
                   2923: 
                   2924: =back
                   2925: 
1.80      albertel 2926: =cut
                   2927: 
                   2928: #-------------------------------------------
                   2929: sub get_kerberos_defaults {
                   2930:     my $domain=shift;
1.641     raeburn  2931:     my ($krbdef,$krbdefdom);
                   2932:     my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                   2933:     if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
                   2934:         $krbdef = $domdefaults{'auth_def'};
                   2935:         $krbdefdom = $domdefaults{'auth_arg_def'};
                   2936:     } else {
1.80      albertel 2937:         $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
                   2938:         my $krbdefdom=$1;
                   2939:         $krbdefdom=~tr/a-z/A-Z/;
                   2940:         $krbdef = "krb4";
                   2941:     }
                   2942:     return ($krbdef,$krbdefdom);
                   2943: }
1.112     bowersj2 2944: 
1.32      matthew  2945: 
1.46      matthew  2946: ###############################################################
                   2947: ##                Thesaurus Functions                        ##
                   2948: ###############################################################
1.20      www      2949: 
1.46      matthew  2950: =pod
1.20      www      2951: 
1.112     bowersj2 2952: =head1 Thesaurus Functions
                   2953: 
                   2954: =over 4
                   2955: 
1.648     raeburn  2956: =item * &initialize_keywords()
1.46      matthew  2957: 
                   2958: Initializes the package variable %Keywords if it is empty.  Uses the
                   2959: package variable $thesaurus_db_file.
                   2960: 
                   2961: =cut
                   2962: 
                   2963: ###################################################
                   2964: 
                   2965: sub initialize_keywords {
                   2966:     return 1 if (scalar keys(%Keywords));
                   2967:     # If we are here, %Keywords is empty, so fill it up
                   2968:     #   Make sure the file we need exists...
                   2969:     if (! -e $thesaurus_db_file) {
                   2970:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
                   2971:                                  " failed because it does not exist");
                   2972:         return 0;
                   2973:     }
                   2974:     #   Set up the hash as a database
                   2975:     my %thesaurus_db;
                   2976:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 2977:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  2978:         &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
                   2979:                                  $thesaurus_db_file);
                   2980:         return 0;
                   2981:     } 
                   2982:     #  Get the average number of appearances of a word.
                   2983:     my $avecount = $thesaurus_db{'average.count'};
                   2984:     #  Put keywords (those that appear > average) into %Keywords
                   2985:     while (my ($word,$data)=each (%thesaurus_db)) {
                   2986:         my ($count,undef) = split /:/,$data;
                   2987:         $Keywords{$word}++ if ($count > $avecount);
                   2988:     }
                   2989:     untie %thesaurus_db;
                   2990:     # Remove special values from %Keywords.
1.356     albertel 2991:     foreach my $value ('total.count','average.count') {
                   2992:         delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586     raeburn  2993:   }
1.46      matthew  2994:     return 1;
                   2995: }
                   2996: 
                   2997: ###################################################
                   2998: 
                   2999: =pod
                   3000: 
1.648     raeburn  3001: =item * &keyword($word)
1.46      matthew  3002: 
                   3003: Returns true if $word is a keyword.  A keyword is a word that appears more 
                   3004: than the average number of times in the thesaurus database.  Calls 
                   3005: &initialize_keywords
                   3006: 
                   3007: =cut
                   3008: 
                   3009: ###################################################
1.20      www      3010: 
                   3011: sub keyword {
1.46      matthew  3012:     return if (!&initialize_keywords());
                   3013:     my $word=lc(shift());
                   3014:     $word=~s/\W//g;
                   3015:     return exists($Keywords{$word});
1.20      www      3016: }
1.46      matthew  3017: 
                   3018: ###############################################################
                   3019: 
                   3020: =pod 
1.20      www      3021: 
1.648     raeburn  3022: =item * &get_related_words()
1.46      matthew  3023: 
1.160     matthew  3024: Look up a word in the thesaurus.  Takes a scalar argument and returns
1.46      matthew  3025: an array of words.  If the keyword is not in the thesaurus, an empty array
                   3026: will be returned.  The order of the words returned is determined by the
                   3027: database which holds them.
                   3028: 
                   3029: Uses global $thesaurus_db_file.
                   3030: 
1.1057    foxr     3031: 
1.46      matthew  3032: =cut
                   3033: 
                   3034: ###############################################################
                   3035: sub get_related_words {
                   3036:     my $keyword = shift;
                   3037:     my %thesaurus_db;
                   3038:     if (! -e $thesaurus_db_file) {
                   3039:         &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
                   3040:                                  "failed because the file does not exist");
                   3041:         return ();
                   3042:     }
                   3043:     if (! tie(%thesaurus_db,'GDBM_File',
1.53      albertel 3044:               $thesaurus_db_file,&GDBM_READER(),0640)){
1.46      matthew  3045:         return ();
                   3046:     } 
                   3047:     my @Words=();
1.429     www      3048:     my $count=0;
1.46      matthew  3049:     if (exists($thesaurus_db{$keyword})) {
1.356     albertel 3050: 	# The first element is the number of times
                   3051: 	# the word appears.  We do not need it now.
1.429     www      3052: 	my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
                   3053: 	my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
                   3054: 	my $threshold=$mostfrequentcount/10;
                   3055:         foreach my $possibleword (@RelatedWords) {
                   3056:             my ($word,$wordcount)=split(/\,/,$possibleword);
                   3057:             if ($wordcount>$threshold) {
                   3058: 		push(@Words,$word);
                   3059:                 $count++;
                   3060:                 if ($count>10) { last; }
                   3061: 	    }
1.20      www      3062:         }
                   3063:     }
1.46      matthew  3064:     untie %thesaurus_db;
                   3065:     return @Words;
1.14      harris41 3066: }
1.46      matthew  3067: 
1.112     bowersj2 3068: =pod
                   3069: 
                   3070: =back
                   3071: 
                   3072: =cut
1.61      www      3073: 
                   3074: # -------------------------------------------------------------- Plaintext name
1.81      albertel 3075: =pod
                   3076: 
1.112     bowersj2 3077: =head1 User Name Functions
                   3078: 
                   3079: =over 4
                   3080: 
1.648     raeburn  3081: =item * &plainname($uname,$udom,$first)
1.81      albertel 3082: 
1.112     bowersj2 3083: Takes a users logon name and returns it as a string in
1.226     albertel 3084: "first middle last generation" form 
                   3085: if $first is set to 'lastname' then it returns it as
                   3086: 'lastname generation, firstname middlename' if their is a lastname
1.81      albertel 3087: 
                   3088: =cut
1.61      www      3089: 
1.295     www      3090: 
1.81      albertel 3091: ###############################################################
1.61      www      3092: sub plainname {
1.226     albertel 3093:     my ($uname,$udom,$first)=@_;
1.537     albertel 3094:     return if (!defined($uname) || !defined($udom));
1.295     www      3095:     my %names=&getnames($uname,$udom);
1.226     albertel 3096:     my $name=&Apache::lonnet::format_name($names{'firstname'},
                   3097: 					  $names{'middlename'},
                   3098: 					  $names{'lastname'},
                   3099: 					  $names{'generation'},$first);
                   3100:     $name=~s/^\s+//;
1.62      www      3101:     $name=~s/\s+$//;
                   3102:     $name=~s/\s+/ /g;
1.353     albertel 3103:     if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62      www      3104:     return $name;
1.61      www      3105: }
1.66      www      3106: 
                   3107: # -------------------------------------------------------------------- Nickname
1.81      albertel 3108: =pod
                   3109: 
1.648     raeburn  3110: =item * &nickname($uname,$udom)
1.81      albertel 3111: 
                   3112: Gets a users name and returns it as a string as
                   3113: 
                   3114: "&quot;nickname&quot;"
1.66      www      3115: 
1.81      albertel 3116: if the user has a nickname or
                   3117: 
                   3118: "first middle last generation"
                   3119: 
                   3120: if the user does not
                   3121: 
                   3122: =cut
1.66      www      3123: 
                   3124: sub nickname {
                   3125:     my ($uname,$udom)=@_;
1.537     albertel 3126:     return if (!defined($uname) || !defined($udom));
1.295     www      3127:     my %names=&getnames($uname,$udom);
1.68      albertel 3128:     my $name=$names{'nickname'};
1.66      www      3129:     if ($name) {
                   3130:        $name='&quot;'.$name.'&quot;'; 
                   3131:     } else {
                   3132:        $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
                   3133: 	     $names{'lastname'}.' '.$names{'generation'};
                   3134:        $name=~s/\s+$//;
                   3135:        $name=~s/\s+/ /g;
                   3136:     }
                   3137:     return $name;
                   3138: }
                   3139: 
1.295     www      3140: sub getnames {
                   3141:     my ($uname,$udom)=@_;
1.537     albertel 3142:     return if (!defined($uname) || !defined($udom));
1.433     albertel 3143:     if ($udom eq 'public' && $uname eq 'public') {
                   3144: 	return ('lastname' => &mt('Public'));
                   3145:     }
1.295     www      3146:     my $id=$uname.':'.$udom;
                   3147:     my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
                   3148:     if ($cached) {
                   3149: 	return %{$names};
                   3150:     } else {
                   3151: 	my %loadnames=&Apache::lonnet::get('environment',
                   3152:                     ['firstname','middlename','lastname','generation','nickname'],
                   3153: 					 $udom,$uname);
                   3154: 	&Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
                   3155: 	return %loadnames;
                   3156:     }
                   3157: }
1.61      www      3158: 
1.542     raeburn  3159: # -------------------------------------------------------------------- getemails
1.648     raeburn  3160: 
1.542     raeburn  3161: =pod
                   3162: 
1.648     raeburn  3163: =item * &getemails($uname,$udom)
1.542     raeburn  3164: 
                   3165: Gets a user's email information and returns it as a hash with keys:
                   3166: notification, critnotification, permanentemail
                   3167: 
                   3168: For notification and critnotification, values are comma-separated lists 
1.648     raeburn  3169: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542     raeburn  3170:  
1.648     raeburn  3171: 
1.542     raeburn  3172: =cut
                   3173: 
1.648     raeburn  3174: 
1.466     albertel 3175: sub getemails {
                   3176:     my ($uname,$udom)=@_;
                   3177:     if ($udom eq 'public' && $uname eq 'public') {
                   3178: 	return;
                   3179:     }
1.467     www      3180:     if (!$udom) { $udom=$env{'user.domain'}; }
                   3181:     if (!$uname) { $uname=$env{'user.name'}; }
1.466     albertel 3182:     my $id=$uname.':'.$udom;
                   3183:     my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
                   3184:     if ($cached) {
                   3185: 	return %{$names};
                   3186:     } else {
                   3187: 	my %loadnames=&Apache::lonnet::get('environment',
                   3188:                     			   ['notification','critnotification',
                   3189: 					    'permanentemail'],
                   3190: 					   $udom,$uname);
                   3191: 	&Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
                   3192: 	return %loadnames;
                   3193:     }
                   3194: }
                   3195: 
1.551     albertel 3196: sub flush_email_cache {
                   3197:     my ($uname,$udom)=@_;
                   3198:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3199:     if (!$uname) { $uname=$env{'user.name'};   }
                   3200:     return if ($udom eq 'public' && $uname eq 'public');
                   3201:     my $id=$uname.':'.$udom;
                   3202:     &Apache::lonnet::devalidate_cache_new('emailscache',$id);
                   3203: }
                   3204: 
1.728     raeburn  3205: # -------------------------------------------------------------------- getlangs
                   3206: 
                   3207: =pod
                   3208: 
                   3209: =item * &getlangs($uname,$udom)
                   3210: 
                   3211: Gets a user's language preference and returns it as a hash with key:
                   3212: language.
                   3213: 
                   3214: =cut
                   3215: 
                   3216: 
                   3217: sub getlangs {
                   3218:     my ($uname,$udom) = @_;
                   3219:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3220:     if (!$uname) { $uname=$env{'user.name'};   }
                   3221:     my $id=$uname.':'.$udom;
                   3222:     my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
                   3223:     if ($cached) {
                   3224:         return %{$langs};
                   3225:     } else {
                   3226:         my %loadlangs=&Apache::lonnet::get('environment',['languages'],
                   3227:                                            $udom,$uname);
                   3228:         &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
                   3229:         return %loadlangs;
                   3230:     }
                   3231: }
                   3232: 
                   3233: sub flush_langs_cache {
                   3234:     my ($uname,$udom)=@_;
                   3235:     if (!$udom)  { $udom =$env{'user.domain'}; }
                   3236:     if (!$uname) { $uname=$env{'user.name'};   }
                   3237:     return if ($udom eq 'public' && $uname eq 'public');
                   3238:     my $id=$uname.':'.$udom;
                   3239:     &Apache::lonnet::devalidate_cache_new('userlangs',$id);
                   3240: }
                   3241: 
1.61      www      3242: # ------------------------------------------------------------------ Screenname
1.81      albertel 3243: 
                   3244: =pod
                   3245: 
1.648     raeburn  3246: =item * &screenname($uname,$udom)
1.81      albertel 3247: 
                   3248: Gets a users screenname and returns it as a string
                   3249: 
                   3250: =cut
1.61      www      3251: 
                   3252: sub screenname {
                   3253:     my ($uname,$udom)=@_;
1.258     albertel 3254:     if ($uname eq $env{'user.name'} &&
                   3255: 	$udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212     albertel 3256:     my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68      albertel 3257:     return $names{'screenname'};
1.62      www      3258: }
                   3259: 
1.212     albertel 3260: 
1.802     bisitz   3261: # ------------------------------------------------------------- Confirm Wrapper
                   3262: =pod
                   3263: 
1.1075.2.42  raeburn  3264: =item * &confirmwrapper($message)
1.802     bisitz   3265: 
                   3266: Wrap messages about completion of operation in box
                   3267: 
                   3268: =cut
                   3269: 
                   3270: sub confirmwrapper {
                   3271:     my ($message)=@_;
                   3272:     if ($message) {
                   3273:         return "\n".'<div class="LC_confirm_box">'."\n"
                   3274:                .$message."\n"
                   3275:                .'</div>'."\n";
                   3276:     } else {
                   3277:         return $message;
                   3278:     }
                   3279: }
                   3280: 
1.62      www      3281: # ------------------------------------------------------------- Message Wrapper
                   3282: 
                   3283: sub messagewrapper {
1.369     www      3284:     my ($link,$username,$domain,$subject,$text)=@_;
1.62      www      3285:     return 
1.441     albertel 3286:         '<a href="/adm/email?compose=individual&amp;'.
                   3287:         'recname='.$username.'&amp;recdom='.$domain.
                   3288: 	'&amp;subject='.&escape($subject).'&amp;text='.&escape($text).'" '.
1.200     matthew  3289:         'title="'.&mt('Send message').'">'.$link.'</a>';
1.74      www      3290: }
1.802     bisitz   3291: 
1.74      www      3292: # --------------------------------------------------------------- Notes Wrapper
                   3293: 
                   3294: sub noteswrapper {
                   3295:     my ($link,$un,$do)=@_;
                   3296:     return 
1.896     amueller 3297: "<a href='/adm/email?recordftf=retrieve&amp;recname=$un&amp;recdom=$do'>$link</a>";
1.62      www      3298: }
1.802     bisitz   3299: 
1.62      www      3300: # ------------------------------------------------------------- Aboutme Wrapper
                   3301: 
                   3302: sub aboutmewrapper {
1.1070    raeburn  3303:     my ($link,$username,$domain,$target,$class)=@_;
1.447     raeburn  3304:     if (!defined($username)  && !defined($domain)) {
                   3305:         return;
                   3306:     }
1.1075.2.15  raeburn  3307:     return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070    raeburn  3308: 	($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62      www      3309: }
                   3310: 
                   3311: # ------------------------------------------------------------ Syllabus Wrapper
                   3312: 
                   3313: sub syllabuswrapper {
1.707     bisitz   3314:     my ($linktext,$coursedir,$domain)=@_;
1.208     matthew  3315:     return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61      www      3316: }
1.14      harris41 3317: 
1.802     bisitz   3318: # -----------------------------------------------------------------------------
                   3319: 
1.208     matthew  3320: sub track_student_link {
1.887     raeburn  3321:     my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268     albertel 3322:     my $link ="/adm/trackstudent?";
1.208     matthew  3323:     my $title = 'View recent activity';
                   3324:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3325:         defined($sdom)  && $sdom  !~ /^\s*$/) {
1.268     albertel 3326:         $link .= "selected_student=$sname:$sdom";
1.208     matthew  3327:         $title .= ' of this student';
1.268     albertel 3328:     } 
1.208     matthew  3329:     if (defined($target) && $target !~ /^\s*$/) {
                   3330:         $target = qq{target="$target"};
                   3331:     } else {
                   3332:         $target = '';
                   3333:     }
1.268     albertel 3334:     if ($start) { $link.='&amp;start='.$start; }
1.887     raeburn  3335:     if ($only_body) { $link .= '&amp;only_body=1'; }
1.554     albertel 3336:     $title = &mt($title);
                   3337:     $linktext = &mt($linktext);
1.448     albertel 3338:     return qq{<a href="$link" title="$title" $target>$linktext</a>}.
                   3339: 	&help_open_topic('View_recent_activity');
1.208     matthew  3340: }
                   3341: 
1.781     raeburn  3342: sub slot_reservations_link {
                   3343:     my ($linktext,$sname,$sdom,$target) = @_;
                   3344:     my $link ="/adm/slotrequest?command=showresv&amp;origin=aboutme";
                   3345:     my $title = 'View slot reservation history';
                   3346:     if (defined($sname) && $sname !~ /^\s*$/ &&
                   3347:         defined($sdom)  && $sdom  !~ /^\s*$/) {
                   3348:         $link .= "&amp;uname=$sname&amp;udom=$sdom";
                   3349:         $title .= ' of this student';
                   3350:     }
                   3351:     if (defined($target) && $target !~ /^\s*$/) {
                   3352:         $target = qq{target="$target"};
                   3353:     } else {
                   3354:         $target = '';
                   3355:     }
                   3356:     $title = &mt($title);
                   3357:     $linktext = &mt($linktext);
                   3358:     return qq{<a href="$link" title="$title" $target>$linktext</a>};
                   3359: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
                   3360: 
                   3361: }
                   3362: 
1.508     www      3363: # ===================================================== Display a student photo
                   3364: 
                   3365: 
1.509     albertel 3366: sub student_image_tag {
1.508     www      3367:     my ($domain,$user)=@_;
                   3368:     my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
                   3369:     if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
                   3370: 	return '<img src="'.$imgsrc.'" align="right" />';
                   3371:     } else {
                   3372: 	return '';
                   3373:     }
                   3374: }
                   3375: 
1.112     bowersj2 3376: =pod
                   3377: 
                   3378: =back
                   3379: 
                   3380: =head1 Access .tab File Data
                   3381: 
                   3382: =over 4
                   3383: 
1.648     raeburn  3384: =item * &languageids() 
1.112     bowersj2 3385: 
                   3386: returns list of all language ids
                   3387: 
                   3388: =cut
                   3389: 
1.14      harris41 3390: sub languageids {
1.16      harris41 3391:     return sort(keys(%language));
1.14      harris41 3392: }
                   3393: 
1.112     bowersj2 3394: =pod
                   3395: 
1.648     raeburn  3396: =item * &languagedescription() 
1.112     bowersj2 3397: 
                   3398: returns description of a specified language id
                   3399: 
                   3400: =cut
                   3401: 
1.14      harris41 3402: sub languagedescription {
1.125     www      3403:     my $code=shift;
                   3404:     return  ($supported_language{$code}?'* ':'').
                   3405:             $language{$code}.
1.126     www      3406: 	    ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145     www      3407: }
                   3408: 
1.1048    foxr     3409: =pod
                   3410: 
                   3411: =item * &plainlanguagedescription
                   3412: 
                   3413: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
                   3414: and the language character encoding (e.g. ISO) separated by a ' - ' string.
                   3415: 
                   3416: =cut
                   3417: 
1.145     www      3418: sub plainlanguagedescription {
                   3419:     my $code=shift;
                   3420:     return $language{$code};
                   3421: }
                   3422: 
1.1048    foxr     3423: =pod
                   3424: 
                   3425: =item * &supportedlanguagecode
                   3426: 
                   3427: Returns the supported language code (e.g. sptutf maps to pt) given a language
                   3428: code.
                   3429: 
                   3430: =cut
                   3431: 
1.145     www      3432: sub supportedlanguagecode {
                   3433:     my $code=shift;
                   3434:     return $supported_language{$code};
1.97      www      3435: }
                   3436: 
1.112     bowersj2 3437: =pod
                   3438: 
1.1048    foxr     3439: =item * &latexlanguage()
                   3440: 
                   3441: Given a language key code returns the correspondnig language to use
                   3442: to select the correct hyphenation on LaTeX printouts.  This is undef if there
                   3443: is no supported hyphenation for the language code.
                   3444: 
                   3445: =cut
                   3446: 
                   3447: sub latexlanguage {
                   3448:     my $code = shift;
                   3449:     return $latex_language{$code};
                   3450: }
                   3451: 
                   3452: =pod
                   3453: 
                   3454: =item * &latexhyphenation()
                   3455: 
                   3456: Same as above but what's supplied is the language as it might be stored
                   3457: in the metadata.
                   3458: 
                   3459: =cut
                   3460: 
                   3461: sub latexhyphenation {
                   3462:     my $key = shift;
                   3463:     return $latex_language_bykey{$key};
                   3464: }
                   3465: 
                   3466: =pod
                   3467: 
1.648     raeburn  3468: =item * &copyrightids() 
1.112     bowersj2 3469: 
                   3470: returns list of all copyrights
                   3471: 
                   3472: =cut
                   3473: 
                   3474: sub copyrightids {
                   3475:     return sort(keys(%cprtag));
                   3476: }
                   3477: 
                   3478: =pod
                   3479: 
1.648     raeburn  3480: =item * &copyrightdescription() 
1.112     bowersj2 3481: 
                   3482: returns description of a specified copyright id
                   3483: 
                   3484: =cut
                   3485: 
                   3486: sub copyrightdescription {
1.166     www      3487:     return &mt($cprtag{shift(@_)});
1.112     bowersj2 3488: }
1.197     matthew  3489: 
                   3490: =pod
                   3491: 
1.648     raeburn  3492: =item * &source_copyrightids() 
1.192     taceyjo1 3493: 
                   3494: returns list of all source copyrights
                   3495: 
                   3496: =cut
                   3497: 
                   3498: sub source_copyrightids {
                   3499:     return sort(keys(%scprtag));
                   3500: }
                   3501: 
                   3502: =pod
                   3503: 
1.648     raeburn  3504: =item * &source_copyrightdescription() 
1.192     taceyjo1 3505: 
                   3506: returns description of a specified source copyright id
                   3507: 
                   3508: =cut
                   3509: 
                   3510: sub source_copyrightdescription {
                   3511:     return &mt($scprtag{shift(@_)});
                   3512: }
1.112     bowersj2 3513: 
                   3514: =pod
                   3515: 
1.648     raeburn  3516: =item * &filecategories() 
1.112     bowersj2 3517: 
                   3518: returns list of all file categories
                   3519: 
                   3520: =cut
                   3521: 
                   3522: sub filecategories {
                   3523:     return sort(keys(%category_extensions));
                   3524: }
                   3525: 
                   3526: =pod
                   3527: 
1.648     raeburn  3528: =item * &filecategorytypes() 
1.112     bowersj2 3529: 
                   3530: returns list of file types belonging to a given file
                   3531: category
                   3532: 
                   3533: =cut
                   3534: 
                   3535: sub filecategorytypes {
1.356     albertel 3536:     my ($cat) = @_;
                   3537:     return @{$category_extensions{lc($cat)}};
1.112     bowersj2 3538: }
                   3539: 
                   3540: =pod
                   3541: 
1.648     raeburn  3542: =item * &fileembstyle() 
1.112     bowersj2 3543: 
                   3544: returns embedding style for a specified file type
                   3545: 
                   3546: =cut
                   3547: 
                   3548: sub fileembstyle {
                   3549:     return $fe{lc(shift(@_))};
1.169     www      3550: }
                   3551: 
1.351     www      3552: sub filemimetype {
                   3553:     return $fm{lc(shift(@_))};
                   3554: }
                   3555: 
1.169     www      3556: 
                   3557: sub filecategoryselect {
                   3558:     my ($name,$value)=@_;
1.189     matthew  3559:     return &select_form($value,$name,
1.970     raeburn  3560:                         {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112     bowersj2 3561: }
                   3562: 
                   3563: =pod
                   3564: 
1.648     raeburn  3565: =item * &filedescription() 
1.112     bowersj2 3566: 
                   3567: returns description for a specified file type
                   3568: 
                   3569: =cut
                   3570: 
                   3571: sub filedescription {
1.188     matthew  3572:     my $file_description = $fd{lc(shift())};
                   3573:     $file_description =~ s:([\[\]]):~$1:g;
                   3574:     return &mt($file_description);
1.112     bowersj2 3575: }
                   3576: 
                   3577: =pod
                   3578: 
1.648     raeburn  3579: =item * &filedescriptionex() 
1.112     bowersj2 3580: 
                   3581: returns description for a specified file type with
                   3582: extra formatting
                   3583: 
                   3584: =cut
                   3585: 
                   3586: sub filedescriptionex {
                   3587:     my $ex=shift;
1.188     matthew  3588:     my $file_description = $fd{lc($ex)};
                   3589:     $file_description =~ s:([\[\]]):~$1:g;
                   3590:     return '.'.$ex.' '.&mt($file_description);
1.112     bowersj2 3591: }
                   3592: 
                   3593: # End of .tab access
                   3594: =pod
                   3595: 
                   3596: =back
                   3597: 
                   3598: =cut
                   3599: 
                   3600: # ------------------------------------------------------------------ File Types
                   3601: sub fileextensions {
                   3602:     return sort(keys(%fe));
                   3603: }
                   3604: 
1.97      www      3605: # ----------------------------------------------------------- Display Languages
                   3606: # returns a hash with all desired display languages
                   3607: #
                   3608: 
                   3609: sub display_languages {
                   3610:     my %languages=();
1.695     raeburn  3611:     foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356     albertel 3612: 	$languages{$lang}=1;
1.97      www      3613:     }
                   3614:     &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258     albertel 3615:     if ($env{'form.displaylanguage'}) {
1.356     albertel 3616: 	foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
                   3617: 	    $languages{$lang}=1;
1.97      www      3618:         }
                   3619:     }
                   3620:     return %languages;
1.14      harris41 3621: }
                   3622: 
1.582     albertel 3623: sub languages {
                   3624:     my ($possible_langs) = @_;
1.695     raeburn  3625:     my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582     albertel 3626:     if (!ref($possible_langs)) {
                   3627: 	if( wantarray ) {
                   3628: 	    return @preferred_langs;
                   3629: 	} else {
                   3630: 	    return $preferred_langs[0];
                   3631: 	}
                   3632:     }
                   3633:     my %possibilities = map { $_ => 1 } (@$possible_langs);
                   3634:     my @preferred_possibilities;
                   3635:     foreach my $preferred_lang (@preferred_langs) {
                   3636: 	if (exists($possibilities{$preferred_lang})) {
                   3637: 	    push(@preferred_possibilities, $preferred_lang);
                   3638: 	}
                   3639:     }
                   3640:     if( wantarray ) {
                   3641: 	return @preferred_possibilities;
                   3642:     }
                   3643:     return $preferred_possibilities[0];
                   3644: }
                   3645: 
1.742     raeburn  3646: sub user_lang {
                   3647:     my ($touname,$toudom,$fromcid) = @_;
                   3648:     my @userlangs;
                   3649:     if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
                   3650:         @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
                   3651:                     $env{'course.'.$fromcid.'.languages'}));
                   3652:     } else {
                   3653:         my %langhash = &getlangs($touname,$toudom);
                   3654:         if ($langhash{'languages'} ne '') {
                   3655:             @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
                   3656:         } else {
                   3657:             my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
                   3658:             if ($domdefs{'lang_def'} ne '') {
                   3659:                 @userlangs = ($domdefs{'lang_def'});
                   3660:             }
                   3661:         }
                   3662:     }
                   3663:     my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
                   3664:     my $user_lh = Apache::localize->get_handle(@languages);
                   3665:     return $user_lh;
                   3666: }
                   3667: 
                   3668: 
1.112     bowersj2 3669: ###############################################################
                   3670: ##               Student Answer Attempts                     ##
                   3671: ###############################################################
                   3672: 
                   3673: =pod
                   3674: 
                   3675: =head1 Alternate Problem Views
                   3676: 
                   3677: =over 4
                   3678: 
1.648     raeburn  3679: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.112     bowersj2 3680:     $getattempt, $regexp, $gradesub)
                   3681: 
                   3682: Return string with previous attempt on problem. Arguments:
                   3683: 
                   3684: =over 4
                   3685: 
                   3686: =item * $symb: Problem, including path
                   3687: 
                   3688: =item * $username: username of the desired student
                   3689: 
                   3690: =item * $domain: domain of the desired student
1.14      harris41 3691: 
1.112     bowersj2 3692: =item * $course: Course ID
1.14      harris41 3693: 
1.112     bowersj2 3694: =item * $getattempt: Leave blank for all attempts, otherwise put
                   3695:     something
1.14      harris41 3696: 
1.112     bowersj2 3697: =item * $regexp: if string matches this regexp, the string will be
                   3698:     sent to $gradesub
1.14      harris41 3699: 
1.112     bowersj2 3700: =item * $gradesub: routine that processes the string if it matches $regexp
1.14      harris41 3701: 
1.112     bowersj2 3702: =back
1.14      harris41 3703: 
1.112     bowersj2 3704: The output string is a table containing all desired attempts, if any.
1.16      harris41 3705: 
1.112     bowersj2 3706: =cut
1.1       albertel 3707: 
                   3708: sub get_previous_attempt {
1.43      ng       3709:   my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub)=@_;
1.1       albertel 3710:   my $prevattempts='';
1.43      ng       3711:   no strict 'refs';
1.1       albertel 3712:   if ($symb) {
1.3       albertel 3713:     my (%returnhash)=
                   3714:       &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1       albertel 3715:     if ($returnhash{'version'}) {
                   3716:       my %lasthash=();
                   3717:       my $version;
                   3718:       for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356     albertel 3719:         foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
                   3720: 	  $lasthash{$key}=$returnhash{$version.':'.$key};
1.19      harris41 3721:         }
1.1       albertel 3722:       }
1.596     albertel 3723:       $prevattempts=&start_data_table().&start_data_table_header_row();
                   3724:       $prevattempts.='<th>'.&mt('History').'</th>';
1.978     raeburn  3725:       my (%typeparts,%lasthidden);
1.945     raeburn  3726:       my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356     albertel 3727:       foreach my $key (sort(keys(%lasthash))) {
                   3728: 	my ($ign,@parts) = split(/\./,$key);
1.41      ng       3729: 	if ($#parts > 0) {
1.31      albertel 3730: 	  my $data=$parts[-1];
1.989     raeburn  3731:           next if ($data eq 'foilorder');
1.31      albertel 3732: 	  pop(@parts);
1.1010    www      3733:           $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.'&nbsp;</th>';
1.945     raeburn  3734:           if ($data eq 'type') {
                   3735:               unless ($showsurv) {
                   3736:                   my $id = join(',',@parts);
                   3737:                   $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978     raeburn  3738:                   if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
                   3739:                       $lasthidden{$ign.'.'.$id} = 1;
                   3740:                   }
1.945     raeburn  3741:               }
1.1010    www      3742:           } 
1.31      albertel 3743: 	} else {
1.41      ng       3744: 	  if ($#parts == 0) {
                   3745: 	    $prevattempts.='<th>'.$parts[0].'</th>';
                   3746: 	  } else {
                   3747: 	    $prevattempts.='<th>'.$ign.'</th>';
                   3748: 	  }
1.31      albertel 3749: 	}
1.16      harris41 3750:       }
1.596     albertel 3751:       $prevattempts.=&end_data_table_header_row();
1.40      ng       3752:       if ($getattempt eq '') {
                   3753: 	for ($version=1;$version<=$returnhash{'version'};$version++) {
1.945     raeburn  3754:             my @hidden;
                   3755:             if (%typeparts) {
                   3756:                 foreach my $id (keys(%typeparts)) {
                   3757:                     if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
                   3758:                         push(@hidden,$id);
                   3759:                     }
                   3760:                 }
                   3761:             }
                   3762:             $prevattempts.=&start_data_table_row().
                   3763:                            '<td>'.&mt('Transaction [_1]',$version).'</td>';
                   3764:             if (@hidden) {
                   3765:                 foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3766:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3767:                     my $hide;
                   3768:                     foreach my $id (@hidden) {
                   3769:                         if ($key =~ /^\Q$id\E/) {
                   3770:                             $hide = 1;
                   3771:                             last;
                   3772:                         }
                   3773:                     }
                   3774:                     if ($hide) {
                   3775:                         my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3776:                         if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3777:                             my $value = &format_previous_attempt_value($key,
                   3778:                                              $returnhash{$version.':'.$key});
                   3779:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3780:                         } else {
                   3781:                             $prevattempts.='<td>&nbsp;</td>';
                   3782:                         }
                   3783:                     } else {
                   3784:                         if ($key =~ /\./) {
                   3785:                             my $value = &format_previous_attempt_value($key,
                   3786:                                               $returnhash{$version.':'.$key});
                   3787:                             $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3788:                         } else {
                   3789:                             $prevattempts.='<td>&nbsp;</td>';
                   3790:                         }
                   3791:                     }
                   3792:                 }
                   3793:             } else {
                   3794: 	        foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3795:                     next if ($key =~ /\.foilorder$/);
1.945     raeburn  3796: 		    my $value = &format_previous_attempt_value($key,
                   3797: 			            $returnhash{$version.':'.$key});
                   3798: 		    $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3799: 	        }
                   3800:             }
                   3801: 	    $prevattempts.=&end_data_table_row();
1.40      ng       3802: 	 }
1.1       albertel 3803:       }
1.945     raeburn  3804:       my @currhidden = keys(%lasthidden);
1.596     albertel 3805:       $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356     albertel 3806:       foreach my $key (sort(keys(%lasthash))) {
1.989     raeburn  3807:           next if ($key =~ /\.foilorder$/);
1.945     raeburn  3808:           if (%typeparts) {
                   3809:               my $hidden;
                   3810:               foreach my $id (@currhidden) {
                   3811:                   if ($key =~ /^\Q$id\E/) {
                   3812:                       $hidden = 1;
                   3813:                       last;
                   3814:                   }
                   3815:               }
                   3816:               if ($hidden) {
                   3817:                   my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
                   3818:                   if (($data eq 'award') || ($data eq 'awarddetail')) {
                   3819:                       my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3820:                       if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3821:                           $value = &$gradesub($value);
                   3822:                       }
                   3823:                       $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3824:                   } else {
                   3825:                       $prevattempts.='<td>&nbsp;</td>';
                   3826:                   }
                   3827:               } else {
                   3828:                   my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3829:                   if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3830:                       $value = &$gradesub($value);
                   3831:                   }
                   3832:                   $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3833:               }
                   3834:           } else {
                   3835: 	      my $value = &format_previous_attempt_value($key,$lasthash{$key});
                   3836: 	      if ($key =~/$regexp$/ && (defined &$gradesub)) {
                   3837:                   $value = &$gradesub($value);
                   3838:               }
                   3839: 	      $prevattempts.='<td>'.$value.'&nbsp;</td>';
                   3840:           }
1.16      harris41 3841:       }
1.596     albertel 3842:       $prevattempts.= &end_data_table_row().&end_data_table();
1.1       albertel 3843:     } else {
1.596     albertel 3844:       $prevattempts=
                   3845: 	  &start_data_table().&start_data_table_row().
                   3846: 	  '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
                   3847: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3848:     }
                   3849:   } else {
1.596     albertel 3850:     $prevattempts=
                   3851: 	  &start_data_table().&start_data_table_row().
                   3852: 	  '<td>'.&mt('No data.').'</td>'.
                   3853: 	  &end_data_table_row().&end_data_table();
1.1       albertel 3854:   }
1.10      albertel 3855: }
                   3856: 
1.581     albertel 3857: sub format_previous_attempt_value {
                   3858:     my ($key,$value) = @_;
1.1011    www      3859:     if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581     albertel 3860: 	$value = &Apache::lonlocal::locallocaltime($value);
                   3861:     } elsif (ref($value) eq 'ARRAY') {
                   3862: 	$value = '('.join(', ', @{ $value }).')';
1.988     raeburn  3863:     } elsif ($key =~ /answerstring$/) {
                   3864:         my %answers = &Apache::lonnet::str2hash($value);
                   3865:         my @anskeys = sort(keys(%answers));
                   3866:         if (@anskeys == 1) {
                   3867:             my $answer = $answers{$anskeys[0]};
1.1001    raeburn  3868:             if ($answer =~ m{\0}) {
                   3869:                 $answer =~ s{\0}{,}g;
1.988     raeburn  3870:             }
                   3871:             my $tag_internal_answer_name = 'INTERNAL';
                   3872:             if ($anskeys[0] eq $tag_internal_answer_name) {
                   3873:                 $value = $answer; 
                   3874:             } else {
                   3875:                 $value = $anskeys[0].'='.$answer;
                   3876:             }
                   3877:         } else {
                   3878:             foreach my $ans (@anskeys) {
                   3879:                 my $answer = $answers{$ans};
1.1001    raeburn  3880:                 if ($answer =~ m{\0}) {
                   3881:                     $answer =~ s{\0}{,}g;
1.988     raeburn  3882:                 }
                   3883:                 $value .=  $ans.'='.$answer.'<br />';;
                   3884:             } 
                   3885:         }
1.581     albertel 3886:     } else {
                   3887: 	$value = &unescape($value);
                   3888:     }
                   3889:     return $value;
                   3890: }
                   3891: 
                   3892: 
1.107     albertel 3893: sub relative_to_absolute {
                   3894:     my ($url,$output)=@_;
                   3895:     my $parser=HTML::TokeParser->new(\$output);
                   3896:     my $token;
                   3897:     my $thisdir=$url;
                   3898:     my @rlinks=();
                   3899:     while ($token=$parser->get_token) {
                   3900: 	if ($token->[0] eq 'S') {
                   3901: 	    if ($token->[1] eq 'a') {
                   3902: 		if ($token->[2]->{'href'}) {
                   3903: 		    $rlinks[$#rlinks+1]=$token->[2]->{'href'};
                   3904: 		}
                   3905: 	    } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
                   3906: 		$rlinks[$#rlinks+1]=$token->[2]->{'src'};
                   3907: 	    } elsif ($token->[1] eq 'base') {
                   3908: 		$thisdir=$token->[2]->{'href'};
                   3909: 	    }
                   3910: 	}
                   3911:     }
                   3912:     $thisdir=~s-/[^/]*$--;
1.356     albertel 3913:     foreach my $link (@rlinks) {
1.726     raeburn  3914: 	unless (($link=~/^https?\:\/\//i) ||
1.356     albertel 3915: 		($link=~/^\//) ||
                   3916: 		($link=~/^javascript:/i) ||
                   3917: 		($link=~/^mailto:/i) ||
                   3918: 		($link=~/^\#/)) {
                   3919: 	    my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
                   3920: 	    $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107     albertel 3921: 	}
                   3922:     }
                   3923: # -------------------------------------------------- Deal with Applet codebases
                   3924:     $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
                   3925:     return $output;
                   3926: }
                   3927: 
1.112     bowersj2 3928: =pod
                   3929: 
1.648     raeburn  3930: =item * &get_student_view()
1.112     bowersj2 3931: 
                   3932: show a snapshot of what student was looking at
                   3933: 
                   3934: =cut
                   3935: 
1.10      albertel 3936: sub get_student_view {
1.186     albertel 3937:   my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114     www      3938:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 3939:   my (%form);
1.10      albertel 3940:   my @elements=('symb','courseid','domain','username');
                   3941:   foreach my $element (@elements) {
1.186     albertel 3942:       $form{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 3943:   }
1.186     albertel 3944:   if (defined($moreenv)) {
                   3945:       %form=(%form,%{$moreenv});
                   3946:   }
1.236     albertel 3947:   if (defined($target)) { $form{'grade_target'} = $target; }
1.107     albertel 3948:   $feedurl=&Apache::lonnet::clutter($feedurl);
1.650     www      3949:   my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11      albertel 3950:   $userview=~s/\<body[^\>]*\>//gi;
                   3951:   $userview=~s/\<\/body\>//gi;
                   3952:   $userview=~s/\<html\>//gi;
                   3953:   $userview=~s/\<\/html\>//gi;
                   3954:   $userview=~s/\<head\>//gi;
                   3955:   $userview=~s/\<\/head\>//gi;
                   3956:   $userview=~s/action\s*\=/would_be_action\=/gi;
1.107     albertel 3957:   $userview=&relative_to_absolute($feedurl,$userview);
1.650     www      3958:   if (wantarray) {
                   3959:      return ($userview,$response);
                   3960:   } else {
                   3961:      return $userview;
                   3962:   }
                   3963: }
                   3964: 
                   3965: sub get_student_view_with_retries {
                   3966:   my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
                   3967: 
                   3968:     my $ok = 0;                 # True if we got a good response.
                   3969:     my $content;
                   3970:     my $response;
                   3971: 
                   3972:     # Try to get the student_view done. within the retries count:
                   3973:     
                   3974:     do {
                   3975:          ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
                   3976:          $ok      = $response->is_success;
                   3977:          if (!$ok) {
                   3978:             &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
                   3979:          }
                   3980:          $retries--;
                   3981:     } while (!$ok && ($retries > 0));
                   3982:     
                   3983:     if (!$ok) {
                   3984:        $content = '';          # On error return an empty content.
                   3985:     }
1.651     www      3986:     if (wantarray) {
                   3987:        return ($content, $response);
                   3988:     } else {
                   3989:        return $content;
                   3990:     }
1.11      albertel 3991: }
                   3992: 
1.112     bowersj2 3993: =pod
                   3994: 
1.648     raeburn  3995: =item * &get_student_answers() 
1.112     bowersj2 3996: 
                   3997: show a snapshot of how student was answering problem
                   3998: 
                   3999: =cut
                   4000: 
1.11      albertel 4001: sub get_student_answers {
1.100     sakharuk 4002:   my ($symb,$username,$domain,$courseid,%form) = @_;
1.114     www      4003:   my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186     albertel 4004:   my (%moreenv);
1.11      albertel 4005:   my @elements=('symb','courseid','domain','username');
                   4006:   foreach my $element (@elements) {
1.186     albertel 4007:     $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10      albertel 4008:   }
1.186     albertel 4009:   $moreenv{'grade_target'}='answer';
                   4010:   %moreenv=(%form,%moreenv);
1.497     raeburn  4011:   $feedurl = &Apache::lonnet::clutter($feedurl);
                   4012:   my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10      albertel 4013:   return $userview;
1.1       albertel 4014: }
1.116     albertel 4015: 
                   4016: =pod
                   4017: 
                   4018: =item * &submlink()
                   4019: 
1.242     albertel 4020: Inputs: $text $uname $udom $symb $target
1.116     albertel 4021: 
                   4022: Returns: A link to grades.pm such as to see the SUBM view of a student
                   4023: 
                   4024: =cut
                   4025: 
                   4026: ###############################################
                   4027: sub submlink {
1.242     albertel 4028:     my ($text,$uname,$udom,$symb,$target)=@_;
1.116     albertel 4029:     if (!($uname && $udom)) {
                   4030: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4031: 	    &Apache::lonnet::whichuser($symb);
1.116     albertel 4032: 	if (!$symb) { $symb=$cursymb; }
                   4033:     }
1.254     matthew  4034:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4035:     $symb=&escape($symb);
1.960     bisitz   4036:     if ($target) { $target=" target=\"$target\""; }
                   4037:     return
                   4038:         '<a href="/adm/grades?command=submission'.
                   4039:         '&amp;symb='.$symb.
                   4040:         '&amp;student='.$uname.
                   4041:         '&amp;userdom='.$udom.'"'.
                   4042:         $target.'>'.$text.'</a>';
1.242     albertel 4043: }
                   4044: ##############################################
                   4045: 
                   4046: =pod
                   4047: 
                   4048: =item * &pgrdlink()
                   4049: 
                   4050: Inputs: $text $uname $udom $symb $target
                   4051: 
                   4052: Returns: A link to grades.pm such as to see the PGRD view of a student
                   4053: 
                   4054: =cut
                   4055: 
                   4056: ###############################################
                   4057: sub pgrdlink {
                   4058:     my $link=&submlink(@_);
                   4059:     $link=~s/(&command=submission)/$1&showgrading=yes/;
                   4060:     return $link;
                   4061: }
                   4062: ##############################################
                   4063: 
                   4064: =pod
                   4065: 
                   4066: =item * &pprmlink()
                   4067: 
                   4068: Inputs: $text $uname $udom $symb $target
                   4069: 
                   4070: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283     albertel 4071: student and a specific resource
1.242     albertel 4072: 
                   4073: =cut
                   4074: 
                   4075: ###############################################
                   4076: sub pprmlink {
                   4077:     my ($text,$uname,$udom,$symb,$target)=@_;
                   4078:     if (!($uname && $udom)) {
                   4079: 	(my $cursymb, my $courseid,$udom,$uname)=
1.463     albertel 4080: 	    &Apache::lonnet::whichuser($symb);
1.242     albertel 4081: 	if (!$symb) { $symb=$cursymb; }
                   4082:     }
1.254     matthew  4083:     if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369     www      4084:     $symb=&escape($symb);
1.242     albertel 4085:     if ($target) { $target="target=\"$target\""; }
1.595     albertel 4086:     return '<a href="/adm/parmset?command=set&amp;'.
                   4087: 	'symb='.$symb.'&amp;uname='.$uname.
                   4088: 	'&amp;udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116     albertel 4089: }
                   4090: ##############################################
1.37      matthew  4091: 
1.112     bowersj2 4092: =pod
                   4093: 
                   4094: =back
                   4095: 
                   4096: =cut
                   4097: 
1.37      matthew  4098: ###############################################
1.51      www      4099: 
                   4100: 
                   4101: sub timehash {
1.687     raeburn  4102:     my ($thistime) = @_;
                   4103:     my $timezone = &Apache::lonlocal::gettimezone();
                   4104:     my $dt = DateTime->from_epoch(epoch => $thistime)
                   4105:                      ->set_time_zone($timezone);
                   4106:     my $wday = $dt->day_of_week();
                   4107:     if ($wday == 7) { $wday = 0; }
                   4108:     return ( 'second' => $dt->second(),
                   4109:              'minute' => $dt->minute(),
                   4110:              'hour'   => $dt->hour(),
                   4111:              'day'     => $dt->day_of_month(),
                   4112:              'month'   => $dt->month(),
                   4113:              'year'    => $dt->year(),
                   4114:              'weekday' => $wday,
                   4115:              'dayyear' => $dt->day_of_year(),
                   4116:              'dlsav'   => $dt->is_dst() );
1.51      www      4117: }
                   4118: 
1.370     www      4119: sub utc_string {
                   4120:     my ($date)=@_;
1.371     www      4121:     return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370     www      4122: }
                   4123: 
1.51      www      4124: sub maketime {
                   4125:     my %th=@_;
1.687     raeburn  4126:     my ($epoch_time,$timezone,$dt);
                   4127:     $timezone = &Apache::lonlocal::gettimezone();
                   4128:     eval {
                   4129:         $dt = DateTime->new( year   => $th{'year'},
                   4130:                              month  => $th{'month'},
                   4131:                              day    => $th{'day'},
                   4132:                              hour   => $th{'hour'},
                   4133:                              minute => $th{'minute'},
                   4134:                              second => $th{'second'},
                   4135:                              time_zone => $timezone,
                   4136:                          );
                   4137:     };
                   4138:     if (!$@) {
                   4139:         $epoch_time = $dt->epoch;
                   4140:         if ($epoch_time) {
                   4141:             return $epoch_time;
                   4142:         }
                   4143:     }
1.51      www      4144:     return POSIX::mktime(
                   4145:         ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210     www      4146:          $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70      www      4147: }
                   4148: 
                   4149: #########################################
1.51      www      4150: 
                   4151: sub findallcourses {
1.482     raeburn  4152:     my ($roles,$uname,$udom) = @_;
1.355     albertel 4153:     my %roles;
                   4154:     if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348     albertel 4155:     my %courses;
1.51      www      4156:     my $now=time;
1.482     raeburn  4157:     if (!defined($uname)) {
                   4158:         $uname = $env{'user.name'};
                   4159:     }
                   4160:     if (!defined($udom)) {
                   4161:         $udom = $env{'user.domain'};
                   4162:     }
                   4163:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073    raeburn  4164:         my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482     raeburn  4165:         if (!%roles) {
                   4166:             %roles = (
                   4167:                        cc => 1,
1.907     raeburn  4168:                        co => 1,
1.482     raeburn  4169:                        in => 1,
                   4170:                        ep => 1,
                   4171:                        ta => 1,
                   4172:                        cr => 1,
                   4173:                        st => 1,
                   4174:              );
                   4175:         }
                   4176:         foreach my $entry (keys(%roleshash)) {
                   4177:             my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
                   4178:             if ($trole =~ /^cr/) { 
                   4179:                 next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
                   4180:             } else {
                   4181:                 next if (!exists($roles{$trole}));
                   4182:             }
                   4183:             if ($tend) {
                   4184:                 next if ($tend < $now);
                   4185:             }
                   4186:             if ($tstart) {
                   4187:                 next if ($tstart > $now);
                   4188:             }
1.1058    raeburn  4189:             my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482     raeburn  4190:             (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058    raeburn  4191:             my $value = $trole.'/'.$cdom.'/';
1.482     raeburn  4192:             if ($secpart eq '') {
                   4193:                 ($cnum,$role) = split(/_/,$cnumpart); 
                   4194:                 $sec = 'none';
1.1058    raeburn  4195:                 $value .= $cnum.'/';
1.482     raeburn  4196:             } else {
                   4197:                 $cnum = $cnumpart;
                   4198:                 ($sec,$role) = split(/_/,$secpart);
1.1058    raeburn  4199:                 $value .= $cnum.'/'.$sec;
                   4200:             }
                   4201:             if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4202:                 unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4203:                     push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4204:                 }
                   4205:             } else {
                   4206:                 @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490     raeburn  4207:             }
1.482     raeburn  4208:         }
                   4209:     } else {
                   4210:         foreach my $key (keys(%env)) {
1.483     albertel 4211: 	    if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
                   4212:                  $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482     raeburn  4213: 	        my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
                   4214: 	        next if ($role eq 'ca' || $role eq 'aa');
                   4215: 	        next if (%roles && !exists($roles{$role}));
                   4216: 	        my ($starttime,$endtime)=split(/\./,$env{$key});
                   4217:                 my $active=1;
                   4218:                 if ($starttime) {
                   4219: 		    if ($now<$starttime) { $active=0; }
                   4220:                 }
                   4221:                 if ($endtime) {
                   4222:                     if ($now>$endtime) { $active=0; }
                   4223:                 }
                   4224:                 if ($active) {
1.1058    raeburn  4225:                     my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482     raeburn  4226:                     if ($sec eq '') {
                   4227:                         $sec = 'none';
1.1058    raeburn  4228:                     } else {
                   4229:                         $value .= $sec;
                   4230:                     }
                   4231:                     if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
                   4232:                         unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
                   4233:                             push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
                   4234:                         }
                   4235:                     } else {
                   4236:                         @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482     raeburn  4237:                     }
1.474     raeburn  4238:                 }
                   4239:             }
1.51      www      4240:         }
                   4241:     }
1.474     raeburn  4242:     return %courses;
1.51      www      4243: }
1.37      matthew  4244: 
1.54      www      4245: ###############################################
1.474     raeburn  4246: 
                   4247: sub blockcheck {
1.1075.2.73  raeburn  4248:     my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490     raeburn  4249: 
1.1075.2.73  raeburn  4250:     if (defined($udom) && defined($uname)) {
                   4251:         # If uname and udom are for a course, check for blocks in the course.
                   4252:         if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
                   4253:             my ($startblock,$endblock,$triggerblock) =
                   4254:                 &get_blocks($setters,$activity,$udom,$uname,$url);
                   4255:             return ($startblock,$endblock,$triggerblock);
                   4256:         }
                   4257:     } else {
1.490     raeburn  4258:         $udom = $env{'user.domain'};
                   4259:         $uname = $env{'user.name'};
                   4260:     }
                   4261: 
1.502     raeburn  4262:     my $startblock = 0;
                   4263:     my $endblock = 0;
1.1062    raeburn  4264:     my $triggerblock = '';
1.482     raeburn  4265:     my %live_courses = &findallcourses(undef,$uname,$udom);
1.474     raeburn  4266: 
1.490     raeburn  4267:     # If uname is for a user, and activity is course-specific, i.e.,
                   4268:     # boards, chat or groups, check for blocking in current course only.
1.474     raeburn  4269: 
1.490     raeburn  4270:     if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73  raeburn  4271:          $activity eq 'groups' || $activity eq 'printout') &&
                   4272:         ($env{'request.course.id'})) {
1.490     raeburn  4273:         foreach my $key (keys(%live_courses)) {
                   4274:             if ($key ne $env{'request.course.id'}) {
                   4275:                 delete($live_courses{$key});
                   4276:             }
                   4277:         }
                   4278:     }
                   4279: 
                   4280:     my $otheruser = 0;
                   4281:     my %own_courses;
                   4282:     if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
                   4283:         # Resource belongs to user other than current user.
                   4284:         $otheruser = 1;
                   4285:         # Gather courses for current user
                   4286:         %own_courses = 
                   4287:             &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
                   4288:     }
                   4289: 
                   4290:     # Gather active course roles - course coordinator, instructor, 
                   4291:     # exam proctor, ta, student, or custom role.
1.474     raeburn  4292: 
                   4293:     foreach my $course (keys(%live_courses)) {
1.482     raeburn  4294:         my ($cdom,$cnum);
                   4295:         if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
                   4296:             $cdom = $env{'course.'.$course.'.domain'};
                   4297:             $cnum = $env{'course.'.$course.'.num'};
                   4298:         } else {
1.490     raeburn  4299:             ($cdom,$cnum) = split(/_/,$course); 
1.482     raeburn  4300:         }
                   4301:         my $no_ownblock = 0;
                   4302:         my $no_userblock = 0;
1.533     raeburn  4303:         if ($otheruser && $activity ne 'com') {
1.490     raeburn  4304:             # Check if current user has 'evb' priv for this
                   4305:             if (defined($own_courses{$course})) {
                   4306:                 foreach my $sec (keys(%{$own_courses{$course}})) {
                   4307:                     my $checkrole = 'cm./'.$cdom.'/'.$cnum;
                   4308:                     if ($sec ne 'none') {
                   4309:                         $checkrole .= '/'.$sec;
                   4310:                     }
                   4311:                     if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4312:                         $no_ownblock = 1;
                   4313:                         last;
                   4314:                     }
                   4315:                 }
                   4316:             }
                   4317:             # if they have 'evb' priv and are currently not playing student
                   4318:             next if (($no_ownblock) &&
                   4319:                  ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
                   4320:         }
1.474     raeburn  4321:         foreach my $sec (keys(%{$live_courses{$course}})) {
1.482     raeburn  4322:             my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474     raeburn  4323:             if ($sec ne 'none') {
1.482     raeburn  4324:                 $checkrole .= '/'.$sec;
1.474     raeburn  4325:             }
1.490     raeburn  4326:             if ($otheruser) {
                   4327:                 # Resource belongs to user other than current user.
                   4328:                 # Assemble privs for that user, and check for 'evb' priv.
1.1058    raeburn  4329:                 my (%allroles,%userroles);
                   4330:                 if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
                   4331:                     foreach my $entry (@{$live_courses{$course}{$sec}}) { 
                   4332:                         my ($trole,$tdom,$tnum,$tsec);
                   4333:                         if ($entry =~ /^cr/) {
                   4334:                             ($trole,$tdom,$tnum,$tsec) = 
                   4335:                                 ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
                   4336:                         } else {
                   4337:                            ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
                   4338:                         }
                   4339:                         my ($spec,$area,$trest);
                   4340:                         $area = '/'.$tdom.'/'.$tnum;
                   4341:                         $trest = $tnum;
                   4342:                         if ($tsec ne '') {
                   4343:                             $area .= '/'.$tsec;
                   4344:                             $trest .= '/'.$tsec;
                   4345:                         }
                   4346:                         $spec = $trole.'.'.$area;
                   4347:                         if ($trole =~ /^cr/) {
                   4348:                             &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
                   4349:                                                               $tdom,$spec,$trest,$area);
                   4350:                         } else {
                   4351:                             &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
                   4352:                                                                 $tdom,$spec,$trest,$area);
                   4353:                         }
                   4354:                     }
                   4355:                     my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
                   4356:                     if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
                   4357:                         if ($1) {
                   4358:                             $no_userblock = 1;
                   4359:                             last;
                   4360:                         }
1.486     raeburn  4361:                     }
                   4362:                 }
1.490     raeburn  4363:             } else {
                   4364:                 # Resource belongs to current user
                   4365:                 # Check for 'evb' priv via lonnet::allowed().
1.482     raeburn  4366:                 if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
                   4367:                     $no_ownblock = 1;
                   4368:                     last;
                   4369:                 }
1.474     raeburn  4370:             }
                   4371:         }
                   4372:         # if they have the evb priv and are currently not playing student
1.482     raeburn  4373:         next if (($no_ownblock) &&
1.491     albertel 4374:                  ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482     raeburn  4375:         next if ($no_userblock);
1.474     raeburn  4376: 
1.866     kalberla 4377:         # Retrieve blocking times and identity of locker for course
1.490     raeburn  4378:         # of specified user, unless user has 'evb' privilege.
1.502     raeburn  4379:         
1.1062    raeburn  4380:         my ($start,$end,$trigger) = 
                   4381:             &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502     raeburn  4382:         if (($start != 0) && 
                   4383:             (($startblock == 0) || ($startblock > $start))) {
                   4384:             $startblock = $start;
1.1062    raeburn  4385:             if ($trigger ne '') {
                   4386:                 $triggerblock = $trigger;
                   4387:             }
1.502     raeburn  4388:         }
                   4389:         if (($end != 0)  &&
                   4390:             (($endblock == 0) || ($endblock < $end))) {
                   4391:             $endblock = $end;
1.1062    raeburn  4392:             if ($trigger ne '') {
                   4393:                 $triggerblock = $trigger;
                   4394:             }
1.502     raeburn  4395:         }
1.490     raeburn  4396:     }
1.1062    raeburn  4397:     return ($startblock,$endblock,$triggerblock);
1.490     raeburn  4398: }
                   4399: 
                   4400: sub get_blocks {
1.1062    raeburn  4401:     my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490     raeburn  4402:     my $startblock = 0;
                   4403:     my $endblock = 0;
1.1062    raeburn  4404:     my $triggerblock = '';
1.490     raeburn  4405:     my $course = $cdom.'_'.$cnum;
                   4406:     $setters->{$course} = {};
                   4407:     $setters->{$course}{'staff'} = [];
                   4408:     $setters->{$course}{'times'} = [];
1.1062    raeburn  4409:     $setters->{$course}{'triggers'} = [];
                   4410:     my (@blockers,%triggered);
                   4411:     my $now = time;
                   4412:     my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
                   4413:     if ($activity eq 'docs') {
                   4414:         @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
                   4415:         foreach my $block (@blockers) {
                   4416:             if ($block =~ /^firstaccess____(.+)$/) {
                   4417:                 my $item = $1;
                   4418:                 my $type = 'map';
                   4419:                 my $timersymb = $item;
                   4420:                 if ($item eq 'course') {
                   4421:                     $type = 'course';
                   4422:                 } elsif ($item =~ /___\d+___/) {
                   4423:                     $type = 'resource';
                   4424:                 } else {
                   4425:                     $timersymb = &Apache::lonnet::symbread($item);
                   4426:                 }
                   4427:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4428:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
                   4429:                 $triggered{$block} = {
                   4430:                                        start => $start,
                   4431:                                        end   => $end,
                   4432:                                        type  => $type,
                   4433:                                      };
                   4434:             }
                   4435:         }
                   4436:     } else {
                   4437:         foreach my $block (keys(%commblocks)) {
                   4438:             if ($block =~ m/^(\d+)____(\d+)$/) { 
                   4439:                 my ($start,$end) = ($1,$2);
                   4440:                 if ($start <= time && $end >= time) {
                   4441:                     if (ref($commblocks{$block}) eq 'HASH') {
                   4442:                         if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                   4443:                             if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
                   4444:                                 unless(grep(/^\Q$block\E$/,@blockers)) {
                   4445:                                     push(@blockers,$block);
                   4446:                                 }
                   4447:                             }
                   4448:                         }
                   4449:                     }
                   4450:                 }
                   4451:             } elsif ($block =~ /^firstaccess____(.+)$/) {
                   4452:                 my $item = $1;
                   4453:                 my $timersymb = $item; 
                   4454:                 my $type = 'map';
                   4455:                 if ($item eq 'course') {
                   4456:                     $type = 'course';
                   4457:                 } elsif ($item =~ /___\d+___/) {
                   4458:                     $type = 'resource';
                   4459:                 } else {
                   4460:                     $timersymb = &Apache::lonnet::symbread($item);
                   4461:                 }
                   4462:                 my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
                   4463:                 my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; 
                   4464:                 if ($start && $end) {
                   4465:                     if (($start <= time) && ($end >= time)) {
                   4466:                         unless (grep(/^\Q$block\E$/,@blockers)) {
                   4467:                             push(@blockers,$block);
                   4468:                             $triggered{$block} = {
                   4469:                                                    start => $start,
                   4470:                                                    end   => $end,
                   4471:                                                    type  => $type,
                   4472:                                                  };
                   4473:                         }
                   4474:                     }
1.490     raeburn  4475:                 }
1.1062    raeburn  4476:             }
                   4477:         }
                   4478:     }
                   4479:     foreach my $blocker (@blockers) {
                   4480:         my ($staff_name,$staff_dom,$title,$blocks) =
                   4481:             &parse_block_record($commblocks{$blocker});
                   4482:         push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
                   4483:         my ($start,$end,$triggertype);
                   4484:         if ($blocker =~ m/^(\d+)____(\d+)$/) {
                   4485:             ($start,$end) = ($1,$2);
                   4486:         } elsif (ref($triggered{$blocker}) eq 'HASH') {
                   4487:             $start = $triggered{$blocker}{'start'};
                   4488:             $end = $triggered{$blocker}{'end'};
                   4489:             $triggertype = $triggered{$blocker}{'type'};
                   4490:         }
                   4491:         if ($start) {
                   4492:             push(@{$$setters{$course}{'times'}}, [$start,$end]);
                   4493:             if ($triggertype) {
                   4494:                 push(@{$$setters{$course}{'triggers'}},$triggertype);
                   4495:             } else {
                   4496:                 push(@{$$setters{$course}{'triggers'}},0);
                   4497:             }
                   4498:             if ( ($startblock == 0) || ($startblock > $start) ) {
                   4499:                 $startblock = $start;
                   4500:                 if ($triggertype) {
                   4501:                     $triggerblock = $blocker;
1.474     raeburn  4502:                 }
                   4503:             }
1.1062    raeburn  4504:             if ( ($endblock == 0) || ($endblock < $end) ) {
                   4505:                $endblock = $end;
                   4506:                if ($triggertype) {
                   4507:                    $triggerblock = $blocker;
                   4508:                }
                   4509:             }
1.474     raeburn  4510:         }
                   4511:     }
1.1062    raeburn  4512:     return ($startblock,$endblock,$triggerblock);
1.474     raeburn  4513: }
                   4514: 
                   4515: sub parse_block_record {
                   4516:     my ($record) = @_;
                   4517:     my ($setuname,$setudom,$title,$blocks);
                   4518:     if (ref($record) eq 'HASH') {
                   4519:         ($setuname,$setudom) = split(/:/,$record->{'setter'});
                   4520:         $title = &unescape($record->{'event'});
                   4521:         $blocks = $record->{'blocks'};
                   4522:     } else {
                   4523:         my @data = split(/:/,$record,3);
                   4524:         if (scalar(@data) eq 2) {
                   4525:             $title = $data[1];
                   4526:             ($setuname,$setudom) = split(/@/,$data[0]);
                   4527:         } else {
                   4528:             ($setuname,$setudom,$title) = @data;
                   4529:         }
                   4530:         $blocks = { 'com' => 'on' };
                   4531:     }
                   4532:     return ($setuname,$setudom,$title,$blocks);
                   4533: }
                   4534: 
1.854     kalberla 4535: sub blocking_status {
1.1075.2.73  raeburn  4536:     my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061    raeburn  4537:     my %setters;
1.890     droeschl 4538: 
1.1061    raeburn  4539: # check for active blocking
1.1062    raeburn  4540:     my ($startblock,$endblock,$triggerblock) = 
1.1075.2.73  raeburn  4541:         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062    raeburn  4542:     my $blocked = 0;
                   4543:     if ($startblock && $endblock) {
                   4544:         $blocked = 1;
                   4545:     }
1.890     droeschl 4546: 
1.1061    raeburn  4547: # caller just wants to know whether a block is active
                   4548:     if (!wantarray) { return $blocked; }
                   4549: 
                   4550: # build a link to a popup window containing the details
                   4551:     my $querystring  = "?activity=$activity";
                   4552: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062    raeburn  4553:     if ($activity eq 'port') {
                   4554:         $querystring .= "&amp;udom=$udom"      if $udom;
                   4555:         $querystring .= "&amp;uname=$uname"    if $uname;
                   4556:     } elsif ($activity eq 'docs') {
                   4557:         $querystring .= '&amp;url='.&HTML::Entities::encode($url,'&"');
                   4558:     }
1.1061    raeburn  4559: 
                   4560:     my $output .= <<'END_MYBLOCK';
                   4561: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   4562:     var options = "width=" + w + ",height=" + h + ",";
                   4563:     options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   4564:     options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   4565:     var newWin = window.open(url, wdwName, options);
                   4566:     newWin.focus();
                   4567: }
1.890     droeschl 4568: END_MYBLOCK
1.854     kalberla 4569: 
1.1061    raeburn  4570:     $output = Apache::lonhtmlcommon::scripttag($output);
1.890     droeschl 4571:   
1.1061    raeburn  4572:     my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062    raeburn  4573:     my $text = &mt('Communication Blocked');
                   4574:     if ($activity eq 'docs') {
                   4575:         $text = &mt('Content Access Blocked');
1.1063    raeburn  4576:     } elsif ($activity eq 'printout') {
                   4577:         $text = &mt('Printing Blocked');
1.1062    raeburn  4578:     }
1.1061    raeburn  4579:     $output .= <<"END_BLOCK";
1.867     kalberla 4580: <div class='LC_comblock'>
1.869     kalberla 4581:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890     droeschl 4582:   title='$text'>
                   4583:   <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869     kalberla 4584:   <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring' 
1.890     droeschl 4585:   title='$text'>$text</a>
1.867     kalberla 4586: </div>
                   4587: 
                   4588: END_BLOCK
1.474     raeburn  4589: 
1.1061    raeburn  4590:     return ($blocked, $output);
1.854     kalberla 4591: }
1.490     raeburn  4592: 
1.60      matthew  4593: ###############################################
                   4594: 
1.682     raeburn  4595: sub check_ip_acc {
                   4596:     my ($acc)=@_;
                   4597:     &Apache::lonxml::debug("acc is $acc");
                   4598:     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
                   4599:         return 1;
                   4600:     }
                   4601:     my $allowed=0;
                   4602:     my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
                   4603: 
                   4604:     my $name;
                   4605:     foreach my $pattern (split(',',$acc)) {
                   4606:         $pattern =~ s/^\s*//;
                   4607:         $pattern =~ s/\s*$//;
                   4608:         if ($pattern =~ /\*$/) {
                   4609:             #35.8.*
                   4610:             $pattern=~s/\*//;
                   4611:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4612:         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
                   4613:             #35.8.3.[34-56]
                   4614:             my $low=$2;
                   4615:             my $high=$3;
                   4616:             $pattern=$1;
                   4617:             if ($ip =~ /^\Q$pattern\E/) {
                   4618:                 my $last=(split(/\./,$ip))[3];
                   4619:                 if ($last <=$high && $last >=$low) { $allowed=1; }
                   4620:             }
                   4621:         } elsif ($pattern =~ /^\*/) {
                   4622:             #*.msu.edu
                   4623:             $pattern=~s/\*//;
                   4624:             if (!defined($name)) {
                   4625:                 use Socket;
                   4626:                 my $netaddr=inet_aton($ip);
                   4627:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4628:             }
                   4629:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4630:         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
                   4631:             #127.0.0.1
                   4632:             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
                   4633:         } else {
                   4634:             #some.name.com
                   4635:             if (!defined($name)) {
                   4636:                 use Socket;
                   4637:                 my $netaddr=inet_aton($ip);
                   4638:                 ($name)=gethostbyaddr($netaddr,AF_INET);
                   4639:             }
                   4640:             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
                   4641:         }
                   4642:         if ($allowed) { last; }
                   4643:     }
                   4644:     return $allowed;
                   4645: }
                   4646: 
                   4647: ###############################################
                   4648: 
1.60      matthew  4649: =pod
                   4650: 
1.112     bowersj2 4651: =head1 Domain Template Functions
                   4652: 
                   4653: =over 4
                   4654: 
                   4655: =item * &determinedomain()
1.60      matthew  4656: 
                   4657: Inputs: $domain (usually will be undef)
                   4658: 
1.63      www      4659: Returns: Determines which domain should be used for designs
1.60      matthew  4660: 
                   4661: =cut
1.54      www      4662: 
1.60      matthew  4663: ###############################################
1.63      www      4664: sub determinedomain {
                   4665:     my $domain=shift;
1.531     albertel 4666:     if (! $domain) {
1.60      matthew  4667:         # Determine domain if we have not been given one
1.893     raeburn  4668:         $domain = &Apache::lonnet::default_login_domain();
1.258     albertel 4669:         if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
                   4670:         if ($env{'request.role.domain'}) { 
                   4671:             $domain=$env{'request.role.domain'}; 
1.60      matthew  4672:         }
                   4673:     }
1.63      www      4674:     return $domain;
                   4675: }
                   4676: ###############################################
1.517     raeburn  4677: 
1.518     albertel 4678: sub devalidate_domconfig_cache {
                   4679:     my ($udom)=@_;
                   4680:     &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
                   4681: }
                   4682: 
                   4683: # ---------------------- Get domain configuration for a domain
                   4684: sub get_domainconf {
                   4685:     my ($udom) = @_;
                   4686:     my $cachetime=1800;
                   4687:     my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
                   4688:     if (defined($cached)) { return %{$result}; }
                   4689: 
                   4690:     my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948     raeburn  4691: 					     ['login','rolecolors','autoenroll'],$udom);
1.632     raeburn  4692:     my (%designhash,%legacy);
1.518     albertel 4693:     if (keys(%domconfig) > 0) {
                   4694:         if (ref($domconfig{'login'}) eq 'HASH') {
1.632     raeburn  4695:             if (keys(%{$domconfig{'login'}})) {
                   4696:                 foreach my $key (keys(%{$domconfig{'login'}})) {
1.699     raeburn  4697:                     if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946     raeburn  4698:                         if ($key eq 'loginvia') {
                   4699:                             if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013    raeburn  4700:                                 foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948     raeburn  4701:                                     if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
                   4702:                                         if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
                   4703:                                             my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
                   4704:                                             $designhash{$udom.'.login.loginvia'} = $server;
                   4705:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
                   4706: 
                   4707:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
                   4708:                                             } else {
1.1013    raeburn  4709:                                                 $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948     raeburn  4710:                                             }
                   4711:                                             if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
                   4712:                                                 $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
                   4713:                                             }
1.946     raeburn  4714:                                         }
                   4715:                                     }
                   4716:                                 }
                   4717:                             }
                   4718:                         } else {
                   4719:                             foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
                   4720:                                 $designhash{$udom.'.login.'.$key.'_'.$img} = 
                   4721:                                     $domconfig{'login'}{$key}{$img};
                   4722:                             }
1.699     raeburn  4723:                         }
                   4724:                     } else {
                   4725:                         $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
                   4726:                     }
1.632     raeburn  4727:                 }
                   4728:             } else {
                   4729:                 $legacy{'login'} = 1;
1.518     albertel 4730:             }
1.632     raeburn  4731:         } else {
                   4732:             $legacy{'login'} = 1;
1.518     albertel 4733:         }
                   4734:         if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632     raeburn  4735:             if (keys(%{$domconfig{'rolecolors'}})) {
                   4736:                 foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
                   4737:                     if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
                   4738:                         foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
                   4739:                             $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
                   4740:                         }
1.518     albertel 4741:                     }
                   4742:                 }
1.632     raeburn  4743:             } else {
                   4744:                 $legacy{'rolecolors'} = 1;
1.518     albertel 4745:             }
1.632     raeburn  4746:         } else {
                   4747:             $legacy{'rolecolors'} = 1;
1.518     albertel 4748:         }
1.948     raeburn  4749:         if (ref($domconfig{'autoenroll'}) eq 'HASH') {
                   4750:             if ($domconfig{'autoenroll'}{'co-owners'}) {
                   4751:                 $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
                   4752:             }
                   4753:         }
1.632     raeburn  4754:         if (keys(%legacy) > 0) {
                   4755:             my %legacyhash = &get_legacy_domconf($udom);
                   4756:             foreach my $item (keys(%legacyhash)) {
                   4757:                 if ($item =~ /^\Q$udom\E\.login/) {
                   4758:                     if ($legacy{'login'}) { 
                   4759:                         $designhash{$item} = $legacyhash{$item};
                   4760:                     }
                   4761:                 } else {
                   4762:                     if ($legacy{'rolecolors'}) {
                   4763:                         $designhash{$item} = $legacyhash{$item};
                   4764:                     }
1.518     albertel 4765:                 }
                   4766:             }
                   4767:         }
1.632     raeburn  4768:     } else {
                   4769:         %designhash = &get_legacy_domconf($udom); 
1.518     albertel 4770:     }
                   4771:     &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
                   4772: 				  $cachetime);
                   4773:     return %designhash;
                   4774: }
                   4775: 
1.632     raeburn  4776: sub get_legacy_domconf {
                   4777:     my ($udom) = @_;
                   4778:     my %legacyhash;
                   4779:     my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
                   4780:     my $designfile =  $designdir.'/'.$udom.'.tab';
                   4781:     if (-e $designfile) {
                   4782:         if ( open (my $fh,"<$designfile") ) {
                   4783:             while (my $line = <$fh>) {
                   4784:                 next if ($line =~ /^\#/);
                   4785:                 chomp($line);
                   4786:                 my ($key,$val)=(split(/\=/,$line));
                   4787:                 if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
                   4788:             }
                   4789:             close($fh);
                   4790:         }
                   4791:     }
1.1026    raeburn  4792:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632     raeburn  4793:         $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
                   4794:     }
                   4795:     return %legacyhash;
                   4796: }
                   4797: 
1.63      www      4798: =pod
                   4799: 
1.112     bowersj2 4800: =item * &domainlogo()
1.63      www      4801: 
                   4802: Inputs: $domain (usually will be undef)
                   4803: 
                   4804: Returns: A link to a domain logo, if the domain logo exists.
                   4805: If the domain logo does not exist, a description of the domain.
                   4806: 
                   4807: =cut
1.112     bowersj2 4808: 
1.63      www      4809: ###############################################
                   4810: sub domainlogo {
1.517     raeburn  4811:     my $domain = &determinedomain(shift);
1.518     albertel 4812:     my %designhash = &get_domainconf($domain);    
1.517     raeburn  4813:     # See if there is a logo
                   4814:     if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519     raeburn  4815:         my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538     albertel 4816:         if ($imgsrc =~ m{^/(adm|res)/}) {
                   4817: 	    if ($imgsrc =~ m{^/res/}) {
                   4818: 		my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
                   4819: 		&Apache::lonnet::repcopy($local_name);
                   4820: 	    }
                   4821: 	   $imgsrc = &lonhttpdurl($imgsrc);
1.519     raeburn  4822:         } 
                   4823:         return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514     albertel 4824:     } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
                   4825:         return &Apache::lonnet::domain($domain,'description');
1.59      www      4826:     } else {
1.60      matthew  4827:         return '';
1.59      www      4828:     }
                   4829: }
1.63      www      4830: ##############################################
                   4831: 
                   4832: =pod
                   4833: 
1.112     bowersj2 4834: =item * &designparm()
1.63      www      4835: 
                   4836: Inputs: $which parameter; $domain (usually will be undef)
                   4837: 
                   4838: Returns: value of designparamter $which
                   4839: 
                   4840: =cut
1.112     bowersj2 4841: 
1.397     albertel 4842: 
1.400     albertel 4843: ##############################################
1.397     albertel 4844: sub designparm {
                   4845:     my ($which,$domain)=@_;
                   4846:     if (exists($env{'environment.color.'.$which})) {
1.817     bisitz   4847:         return $env{'environment.color.'.$which};
1.96      www      4848:     }
1.63      www      4849:     $domain=&determinedomain($domain);
1.1016    raeburn  4850:     my %domdesign;
                   4851:     unless ($domain eq 'public') {
                   4852:         %domdesign = &get_domainconf($domain);
                   4853:     }
1.520     raeburn  4854:     my $output;
1.517     raeburn  4855:     if ($domdesign{$domain.'.'.$which} ne '') {
1.817     bisitz   4856:         $output = $domdesign{$domain.'.'.$which};
1.63      www      4857:     } else {
1.520     raeburn  4858:         $output = $defaultdesign{$which};
                   4859:     }
                   4860:     if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635     raeburn  4861:         ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538     albertel 4862:         if ($output =~ m{^/(adm|res)/}) {
1.817     bisitz   4863:             if ($output =~ m{^/res/}) {
                   4864:                 my $local_name = &Apache::lonnet::filelocation('',$output);
                   4865:                 &Apache::lonnet::repcopy($local_name);
                   4866:             }
1.520     raeburn  4867:             $output = &lonhttpdurl($output);
                   4868:         }
1.63      www      4869:     }
1.520     raeburn  4870:     return $output;
1.63      www      4871: }
1.59      www      4872: 
1.822     bisitz   4873: ##############################################
                   4874: =pod
                   4875: 
1.832     bisitz   4876: =item * &authorspace()
                   4877: 
1.1028    raeburn  4878: Inputs: $url (usually will be undef).
1.832     bisitz   4879: 
1.1075.2.40  raeburn  4880: Returns: Path to Authoring Space containing the resource or 
1.1028    raeburn  4881:          directory being viewed (or for which action is being taken). 
                   4882:          If $url is provided, and begins /priv/<domain>/<uname>
                   4883:          the path will be that portion of the $context argument.
                   4884:          Otherwise the path will be for the author space of the current
                   4885:          user when the current role is author, or for that of the 
                   4886:          co-author/assistant co-author space when the current role 
                   4887:          is co-author or assistant co-author.
1.832     bisitz   4888: 
                   4889: =cut
                   4890: 
                   4891: sub authorspace {
1.1028    raeburn  4892:     my ($url) = @_;
                   4893:     if ($url ne '') {
                   4894:         if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
                   4895:            return $1;
                   4896:         }
                   4897:     }
1.832     bisitz   4898:     my $caname = '';
1.1024    www      4899:     my $cadom = '';
1.1028    raeburn  4900:     if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024    www      4901:         ($cadom,$caname) =
1.832     bisitz   4902:             ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028    raeburn  4903:     } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832     bisitz   4904:         $caname = $env{'user.name'};
1.1024    www      4905:         $cadom = $env{'user.domain'};
1.832     bisitz   4906:     }
1.1028    raeburn  4907:     if (($caname ne '') && ($cadom ne '')) {
                   4908:         return "/priv/$cadom/$caname/";
                   4909:     }
                   4910:     return;
1.832     bisitz   4911: }
                   4912: 
                   4913: ##############################################
                   4914: =pod
                   4915: 
1.822     bisitz   4916: =item * &head_subbox()
                   4917: 
                   4918: Inputs: $content (contains HTML code with page functions, etc.)
                   4919: 
                   4920: Returns: HTML div with $content
                   4921:          To be included in page header
                   4922: 
                   4923: =cut
                   4924: 
                   4925: sub head_subbox {
                   4926:     my ($content)=@_;
                   4927:     my $output =
1.993     raeburn  4928:         '<div class="LC_head_subbox">'
1.822     bisitz   4929:        .$content
                   4930:        .'</div>'
                   4931: }
                   4932: 
                   4933: ##############################################
                   4934: =pod
                   4935: 
                   4936: =item * &CSTR_pageheader()
                   4937: 
1.1026    raeburn  4938: Input: (optional) filename from which breadcrumb trail is built.
                   4939:        In most cases no input as needed, as $env{'request.filename'}
                   4940:        is appropriate for use in building the breadcrumb trail.
1.822     bisitz   4941: 
                   4942: Returns: HTML div with CSTR path and recent box
1.1075.2.40  raeburn  4943:          To be included on Authoring Space pages
1.822     bisitz   4944: 
                   4945: =cut
                   4946: 
                   4947: sub CSTR_pageheader {
1.1026    raeburn  4948:     my ($trailfile) = @_;
                   4949:     if ($trailfile eq '') {
                   4950:         $trailfile = $env{'request.filename'};
                   4951:     }
                   4952: 
                   4953: # this is for resources; directories have customtitle, and crumbs
                   4954: # and select recent are created in lonpubdir.pm
                   4955: 
                   4956:     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022    www      4957:     my ($udom,$uname,$thisdisfn)=
1.1075.2.29  raeburn  4958:         ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026    raeburn  4959:     my $formaction = "/priv/$udom/$uname/$thisdisfn";
                   4960:     $formaction =~ s{/+}{/}g;
1.822     bisitz   4961: 
                   4962:     my $parentpath = '';
                   4963:     my $lastitem = '';
                   4964:     if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
                   4965:         $parentpath = $1;
                   4966:         $lastitem = $2;
                   4967:     } else {
                   4968:         $lastitem = $thisdisfn;
                   4969:     }
1.921     bisitz   4970: 
                   4971:     my $output =
1.822     bisitz   4972:          '<div>'
                   4973:         .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40  raeburn  4974:         .'<b>'.&mt('Authoring Space:').'</b> '
1.822     bisitz   4975:         .'<form name="dirs" method="post" action="'.$formaction
1.921     bisitz   4976:         .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024    www      4977:         .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921     bisitz   4978: 
                   4979:     if ($lastitem) {
                   4980:         $output .=
                   4981:              '<span class="LC_filename">'
                   4982:             .$lastitem
                   4983:             .'</span>';
                   4984:     }
                   4985:     $output .=
                   4986:          '<br />'
1.822     bisitz   4987:         #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
                   4988:         .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
                   4989:         .'</form>'
                   4990:         .&Apache::lonmenu::constspaceform()
                   4991:         .'</div>';
1.921     bisitz   4992: 
                   4993:     return $output;
1.822     bisitz   4994: }
                   4995: 
1.60      matthew  4996: ###############################################
                   4997: ###############################################
                   4998: 
                   4999: =pod
                   5000: 
1.112     bowersj2 5001: =back
                   5002: 
1.549     albertel 5003: =head1 HTML Helpers
1.112     bowersj2 5004: 
                   5005: =over 4
                   5006: 
                   5007: =item * &bodytag()
1.60      matthew  5008: 
                   5009: Returns a uniform header for LON-CAPA web pages.
                   5010: 
                   5011: Inputs: 
                   5012: 
1.112     bowersj2 5013: =over 4
                   5014: 
                   5015: =item * $title, A title to be displayed on the page.
                   5016: 
                   5017: =item * $function, the current role (can be undef).
                   5018: 
                   5019: =item * $addentries, extra parameters for the <body> tag.
                   5020: 
                   5021: =item * $bodyonly, if defined, only return the <body> tag.
                   5022: 
                   5023: =item * $domain, if defined, force a given domain.
                   5024: 
                   5025: =item * $forcereg, if page should register as content page (relevant for 
1.86      www      5026:             text interface only)
1.60      matthew  5027: 
1.814     bisitz   5028: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
                   5029:                      navigational links
1.317     albertel 5030: 
1.338     albertel 5031: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
                   5032: 
1.1075.2.12  raeburn  5033: =item * $no_inline_link, if true and in remote mode, don't show the
                   5034:          'Switch To Inline Menu' link
                   5035: 
1.460     albertel 5036: =item * $args, optional argument valid values are
                   5037:             no_auto_mt_title -> prevents &mt()ing the title arg
1.562     albertel 5038:             inherit_jsmath -> when creating popup window in a page,
                   5039:                               should it have jsmath forced on by the
                   5040:                               current page
1.460     albertel 5041: 
1.1075.2.15  raeburn  5042: =item * $advtoolsref, optional argument, ref to an array containing
                   5043:             inlineremote items to be added in "Functions" menu below
                   5044:             breadcrumbs.
                   5045: 
1.112     bowersj2 5046: =back
                   5047: 
1.60      matthew  5048: Returns: A uniform header for LON-CAPA web pages.  
                   5049: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
                   5050: If $bodyonly is undef or zero, an html string containing a <body> tag and 
                   5051: other decorations will be returned.
                   5052: 
                   5053: =cut
                   5054: 
1.54      www      5055: sub bodytag {
1.831     bisitz   5056:     my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15  raeburn  5057:         $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339     albertel 5058: 
1.954     raeburn  5059:     my $public;
                   5060:     if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
                   5061:         || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
                   5062:         $public = 1;
                   5063:     }
1.460     albertel 5064:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52  raeburn  5065:     my $httphost = $args->{'use_absolute'};
1.339     albertel 5066: 
1.183     matthew  5067:     $function = &get_users_function() if (!$function);
1.339     albertel 5068:     my $img =    &designparm($function.'.img',$domain);
                   5069:     my $font =   &designparm($function.'.font',$domain);
                   5070:     my $pgbg   = $bgcolor || &designparm($function.'.pgbg',$domain);
                   5071: 
1.803     bisitz   5072:     my %design = ( 'style'   => 'margin-top: 0',
1.535     albertel 5073: 		   'bgcolor' => $pgbg,
1.339     albertel 5074: 		   'text'    => $font,
                   5075:                    'alink'   => &designparm($function.'.alink',$domain),
                   5076: 		   'vlink'   => &designparm($function.'.vlink',$domain),
                   5077: 		   'link'    => &designparm($function.'.link',$domain),);
1.438     albertel 5078:     @design{keys(%$addentries)} = @$addentries{keys(%$addentries)}; 
1.339     albertel 5079: 
1.63      www      5080:  # role and realm
1.1075.2.68  raeburn  5081:     my ($role,$realm) = split(m{\./},$env{'request.role'},2);
                   5082:     if ($realm) {
                   5083:         $realm = '/'.$realm;
                   5084:     }
1.378     raeburn  5085:     if ($role  eq 'ca') {
1.479     albertel 5086:         my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500     albertel 5087:         $realm = &plainname($rname,$rdom);
1.378     raeburn  5088:     } 
1.55      www      5089: # realm
1.258     albertel 5090:     if ($env{'request.course.id'}) {
1.378     raeburn  5091:         if ($env{'request.role'} !~ /^cr/) {
                   5092:             $role = &Apache::lonnet::plaintext($role,&course_type());
                   5093:         }
1.898     raeburn  5094:         if ($env{'request.course.sec'}) {
                   5095:             $role .= ('&nbsp;'x2).'-&nbsp;'.&mt('section:').'&nbsp;'.$env{'request.course.sec'};
                   5096:         }   
1.359     albertel 5097: 	$realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378     raeburn  5098:     } else {
                   5099:         $role = &Apache::lonnet::plaintext($role);
1.54      www      5100:     }
1.433     albertel 5101: 
1.359     albertel 5102:     if (!$realm) { $realm='&nbsp;'; }
1.330     albertel 5103: 
1.438     albertel 5104:     my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329     albertel 5105: 
1.101     www      5106: # construct main body tag
1.359     albertel 5107:     my $bodytag = "<body $extra_body_attr>".
1.562     albertel 5108: 	&Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252     albertel 5109: 
1.1075.2.38  raeburn  5110:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   5111: 
                   5112:     if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60      matthew  5113:         return $bodytag;
1.1075.2.38  raeburn  5114:     }
1.359     albertel 5115: 
1.954     raeburn  5116:     if ($public) {
1.433     albertel 5117: 	undef($role);
                   5118:     }
1.359     albertel 5119:     
1.762     bisitz   5120:     my $titleinfo = '<h1>'.$title.'</h1>';
1.359     albertel 5121:     #
                   5122:     # Extra info if you are the DC
                   5123:     my $dc_info = '';
                   5124:     if ($env{'user.adv'} && exists($env{'user.role.dc./'.
                   5125:                         $env{'course.'.$env{'request.course.id'}.
                   5126:                                  '.domain'}.'/'})) {
                   5127:         my $cid = $env{'request.course.id'};
1.917     raeburn  5128:         $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380     www      5129:         $dc_info =~ s/\s+$//;
1.359     albertel 5130:     }
                   5131: 
1.898     raeburn  5132:     $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903     droeschl 5133: 
1.1075.2.13  raeburn  5134:     if ($env{'request.state'} eq 'construct') { $forcereg=1; }
                   5135: 
1.1075.2.38  raeburn  5136: 
                   5137: 
1.1075.2.21  raeburn  5138:     my $funclist;
                   5139:     if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52  raeburn  5140:         $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21  raeburn  5141:                     Apache::lonmenu::serverform();
                   5142:         my $forbodytag;
                   5143:         &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5144:                                             $forcereg,$args->{'group'},
                   5145:                                             $args->{'bread_crumbs'},
                   5146:                                             $advtoolsref,'',\$forbodytag);
                   5147:         unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5148:             $funclist = $forbodytag;
                   5149:         }
                   5150:     } else {
1.903     droeschl 5151: 
                   5152:         #    if ($env{'request.state'} eq 'construct') {
                   5153:         #        $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
                   5154:         #    }
                   5155: 
1.1075.2.38  raeburn  5156:         $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5157:             Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359     albertel 5158: 
1.1075.2.38  raeburn  5159:         my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2  raeburn  5160: 
1.916     droeschl 5161:         if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22  raeburn  5162:             if ($dc_info) {
                   5163:                  $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1  raeburn  5164:             }
1.1075.2.38  raeburn  5165:             $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22  raeburn  5166:                            <em>$realm</em> $dc_info</div>|;
1.903     droeschl 5167:             return $bodytag;
                   5168:         }
1.894     droeschl 5169: 
1.927     raeburn  5170:         unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38  raeburn  5171:             $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927     raeburn  5172:         }
1.916     droeschl 5173: 
1.1075.2.38  raeburn  5174:         $bodytag .= $right;
1.852     droeschl 5175: 
1.917     raeburn  5176:         if ($dc_info) {
                   5177:             $dc_info = &dc_courseid_toggle($dc_info);
                   5178:         }
                   5179:         $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916     droeschl 5180: 
1.1075.2.61  raeburn  5181:         #if directed to not display the secondary menu, don't.
                   5182:         if ($args->{'no_secondary_menu'}) {
                   5183:             return $bodytag;
                   5184:         }
1.903     droeschl 5185:         #don't show menus for public users
1.954     raeburn  5186:         if (!$public){
1.1075.2.52  raeburn  5187:             $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903     droeschl 5188:             $bodytag .= Apache::lonmenu::serverform();
1.920     raeburn  5189:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
                   5190:             if ($env{'request.state'} eq 'construct') {
1.962     droeschl 5191:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920     raeburn  5192:                                 $args->{'bread_crumbs'});
                   5193:             } elsif ($forcereg) { 
1.1075.2.22  raeburn  5194:                 $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
                   5195:                                                             $args->{'group'});
1.1075.2.15  raeburn  5196:             } else {
1.1075.2.21  raeburn  5197:                 my $forbodytag;
                   5198:                 &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
                   5199:                                                     $forcereg,$args->{'group'},
                   5200:                                                     $args->{'bread_crumbs'},
                   5201:                                                     $advtoolsref,'',\$forbodytag);
                   5202:                 unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
                   5203:                     $bodytag .= $forbodytag;
                   5204:                 }
1.920     raeburn  5205:             }
1.903     droeschl 5206:         }else{
                   5207:             # this is to seperate menu from content when there's no secondary
                   5208:             # menu. Especially needed for public accessible ressources.
                   5209:             $bodytag .= '<hr style="clear:both" />';
                   5210:             $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); 
1.235     raeburn  5211:         }
1.903     droeschl 5212: 
1.235     raeburn  5213:         return $bodytag;
1.1075.2.12  raeburn  5214:     }
                   5215: 
                   5216: #
                   5217: # Top frame rendering, Remote is up
                   5218: #
                   5219: 
                   5220:     my $imgsrc = $img;
                   5221:     if ($img =~ /^\/adm/) {
                   5222:         $imgsrc = &lonhttpdurl($img);
                   5223:     }
                   5224:     my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
                   5225: 
1.1075.2.60  raeburn  5226:     my $help=($no_inline_link?''
                   5227:               :&Apache::loncommon::top_nav_help('Help'));
                   5228: 
1.1075.2.12  raeburn  5229:     # Explicit link to get inline menu
                   5230:     my $menu= ($no_inline_link?''
                   5231:                :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
                   5232: 
                   5233:     if ($dc_info) {
                   5234:         $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
                   5235:     }
                   5236: 
1.1075.2.38  raeburn  5237:     my $name = &plainname($env{'user.name'},$env{'user.domain'});
                   5238:     unless ($public) {
                   5239:         $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
                   5240:                                 undef,'LC_menubuttons_link');
                   5241:     }
                   5242: 
1.1075.2.12  raeburn  5243:     unless ($env{'form.inhibitmenu'}) {
                   5244:         $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38  raeburn  5245:                        <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60  raeburn  5246:                        <li>$help</li>
1.1075.2.12  raeburn  5247:                        <li>$menu</li>
                   5248:                        </ol><div id="LC_realm"> $realm $dc_info</div>|;
                   5249:     }
1.1075.2.13  raeburn  5250:     if ($env{'request.state'} eq 'construct') {
                   5251:         if (!$public){
                   5252:             if ($env{'request.state'} eq 'construct') {
                   5253:                 $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52  raeburn  5254:                                 &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13  raeburn  5255:                             &Apache::lonhtmlcommon::scripttag('','end').
                   5256:                             &Apache::lonmenu::innerregister($forcereg,
                   5257:                                                             $args->{'bread_crumbs'});
                   5258:             }
                   5259:         }
                   5260:     }
1.1075.2.21  raeburn  5261:     return $bodytag."\n".$funclist;
1.182     matthew  5262: }
                   5263: 
1.917     raeburn  5264: sub dc_courseid_toggle {
                   5265:     my ($dc_info) = @_;
1.980     raeburn  5266:     return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069    raeburn  5267:            '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917     raeburn  5268:            &mt('(More ...)').'</a></span>'.
                   5269:            '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
                   5270: }
                   5271: 
1.330     albertel 5272: sub make_attr_string {
                   5273:     my ($register,$attr_ref) = @_;
                   5274: 
                   5275:     if ($attr_ref && !ref($attr_ref)) {
                   5276: 	die("addentries Must be a hash ref ".
                   5277: 	    join(':',caller(1))." ".
                   5278: 	    join(':',caller(0))." ");
                   5279:     }
                   5280: 
                   5281:     if ($register) {
1.339     albertel 5282: 	my ($on_load,$on_unload);
                   5283: 	foreach my $key (keys(%{$attr_ref})) {
                   5284: 	    if      (lc($key) eq 'onload') {
                   5285: 		$on_load.=$attr_ref->{$key}.';';
                   5286: 		delete($attr_ref->{$key});
                   5287: 
                   5288: 	    } elsif (lc($key) eq 'onunload') {
                   5289: 		$on_unload.=$attr_ref->{$key}.';';
                   5290: 		delete($attr_ref->{$key});
                   5291: 	    }
                   5292: 	}
1.1075.2.12  raeburn  5293:         if ($env{'environment.remote'} eq 'on') {
                   5294:             $attr_ref->{'onload'}  =
                   5295:                 &Apache::lonmenu::loadevents().  $on_load;
                   5296:             $attr_ref->{'onunload'}=
                   5297:                 &Apache::lonmenu::unloadevents().$on_unload;
                   5298:         } else {  
                   5299: 	    $attr_ref->{'onload'}  = $on_load;
                   5300: 	    $attr_ref->{'onunload'}= $on_unload;
                   5301:         }
1.330     albertel 5302:     }
1.339     albertel 5303: 
1.330     albertel 5304:     my $attr_string;
1.1075.2.56  raeburn  5305:     foreach my $attr (sort(keys(%$attr_ref))) {
1.330     albertel 5306: 	$attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
                   5307:     }
                   5308:     return $attr_string;
                   5309: }
                   5310: 
                   5311: 
1.182     matthew  5312: ###############################################
1.251     albertel 5313: ###############################################
                   5314: 
                   5315: =pod
                   5316: 
                   5317: =item * &endbodytag()
                   5318: 
                   5319: Returns a uniform footer for LON-CAPA web pages.
                   5320: 
1.635     raeburn  5321: Inputs: 1 - optional reference to an args hash
                   5322: If in the hash, key for noredirectlink has a value which evaluates to true,
                   5323: a 'Continue' link is not displayed if the page contains an
                   5324: internal redirect in the <head></head> section,
                   5325: i.e., $env{'internal.head.redirect'} exists   
1.251     albertel 5326: 
                   5327: =cut
                   5328: 
                   5329: sub endbodytag {
1.635     raeburn  5330:     my ($args) = @_;
1.1075.2.6  raeburn  5331:     my $endbodytag;
                   5332:     unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
                   5333:         $endbodytag='</body>';
                   5334:     }
1.269     albertel 5335:     $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315     albertel 5336:     if ( exists( $env{'internal.head.redirect'} ) ) {
1.635     raeburn  5337:         if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
                   5338: 	    $endbodytag=
                   5339: 	        "<br /><a href=\"$env{'internal.head.redirect'}\">".
                   5340: 	        &mt('Continue').'</a>'.
                   5341: 	        $endbodytag;
                   5342:         }
1.315     albertel 5343:     }
1.251     albertel 5344:     return $endbodytag;
                   5345: }
                   5346: 
1.352     albertel 5347: =pod
                   5348: 
                   5349: =item * &standard_css()
                   5350: 
                   5351: Returns a style sheet
                   5352: 
                   5353: Inputs: (all optional)
                   5354:             domain         -> force to color decorate a page for a specific
                   5355:                                domain
                   5356:             function       -> force usage of a specific rolish color scheme
                   5357:             bgcolor        -> override the default page bgcolor
                   5358: 
                   5359: =cut
                   5360: 
1.343     albertel 5361: sub standard_css {
1.345     albertel 5362:     my ($function,$domain,$bgcolor) = @_;
1.352     albertel 5363:     $function  = &get_users_function() if (!$function);
                   5364:     my $img    = &designparm($function.'.img',   $domain);
                   5365:     my $tabbg  = &designparm($function.'.tabbg', $domain);
                   5366:     my $font   = &designparm($function.'.font',  $domain);
1.801     tempelho 5367:     my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791     tempelho 5368: #second colour for later usage
1.345     albertel 5369:     my $sidebg = &designparm($function.'.sidebg',$domain);
1.382     albertel 5370:     my $pgbg_or_bgcolor =
                   5371: 	         $bgcolor ||
1.352     albertel 5372: 	         &designparm($function.'.pgbg',  $domain);
1.382     albertel 5373:     my $pgbg   = &designparm($function.'.pgbg',  $domain);
1.352     albertel 5374:     my $alink  = &designparm($function.'.alink', $domain);
                   5375:     my $vlink  = &designparm($function.'.vlink', $domain);
                   5376:     my $link   = &designparm($function.'.link',  $domain);
                   5377: 
1.602     albertel 5378:     my $sans                 = 'Verdana,Arial,Helvetica,sans-serif';
1.395     albertel 5379:     my $mono                 = 'monospace';
1.850     bisitz   5380:     my $data_table_head      = $sidebg;
                   5381:     my $data_table_light     = '#FAFAFA';
1.1060    bisitz   5382:     my $data_table_dark      = '#E0E0E0';
1.470     banghart 5383:     my $data_table_darker    = '#CCCCCC';
1.349     albertel 5384:     my $data_table_highlight = '#FFFF00';
1.352     albertel 5385:     my $mail_new             = '#FFBB77';
                   5386:     my $mail_new_hover       = '#DD9955';
                   5387:     my $mail_read            = '#BBBB77';
                   5388:     my $mail_read_hover      = '#999944';
                   5389:     my $mail_replied         = '#AAAA88';
                   5390:     my $mail_replied_hover   = '#888855';
                   5391:     my $mail_other           = '#99BBBB';
                   5392:     my $mail_other_hover     = '#669999';
1.391     albertel 5393:     my $table_header         = '#DDDDDD';
1.489     raeburn  5394:     my $feedback_link_bg     = '#BBBBBB';
1.911     bisitz   5395:     my $lg_border_color      = '#C8C8C8';
1.952     onken    5396:     my $button_hover         = '#BF2317';
1.392     albertel 5397: 
1.608     albertel 5398:     my $border = ($env{'browser.type'} eq 'explorer' ||
1.911     bisitz   5399:       $env{'browser.type'} eq 'safari'     ) ? '0 2px 0 2px'
                   5400:                                              : '0 3px 0 4px';
1.448     albertel 5401: 
1.523     albertel 5402: 
1.343     albertel 5403:     return <<END;
1.947     droeschl 5404: 
                   5405: /* needed for iframe to allow 100% height in FF */
                   5406: body, html { 
                   5407:     margin: 0;
                   5408:     padding: 0 0.5%;
                   5409:     height: 99%; /* to avoid scrollbars */
                   5410: }
                   5411: 
1.795     www      5412: body {
1.911     bisitz   5413:   font-family: $sans;
                   5414:   line-height:130%;
                   5415:   font-size:0.83em;
                   5416:   color:$font;
1.795     www      5417: }
                   5418: 
1.959     onken    5419: a:focus,
                   5420: a:focus img {
1.795     www      5421:   color: red;
                   5422: }
1.698     harmsja  5423: 
1.911     bisitz   5424: form, .inline {
                   5425:   display: inline;
1.795     www      5426: }
1.721     harmsja  5427: 
1.795     www      5428: .LC_right {
1.911     bisitz   5429:   text-align:right;
1.795     www      5430: }
                   5431: 
                   5432: .LC_middle {
1.911     bisitz   5433:   vertical-align:middle;
1.795     www      5434: }
1.721     harmsja  5435: 
1.1075.2.38  raeburn  5436: .LC_floatleft {
                   5437:   float: left;
                   5438: }
                   5439: 
                   5440: .LC_floatright {
                   5441:   float: right;
                   5442: }
                   5443: 
1.911     bisitz   5444: .LC_400Box {
                   5445:   width:400px;
                   5446: }
1.721     harmsja  5447: 
1.947     droeschl 5448: .LC_iframecontainer {
                   5449:     width: 98%;
                   5450:     margin: 0;
                   5451:     position: fixed;
                   5452:     top: 8.5em;
                   5453:     bottom: 0;
                   5454: }
                   5455: 
                   5456: .LC_iframecontainer iframe{
                   5457:     border: none;
                   5458:     width: 100%;
                   5459:     height: 100%;
                   5460: }
                   5461: 
1.778     bisitz   5462: .LC_filename {
                   5463:   font-family: $mono;
                   5464:   white-space:pre;
1.921     bisitz   5465:   font-size: 120%;
1.778     bisitz   5466: }
                   5467: 
                   5468: .LC_fileicon {
                   5469:   border: none;
                   5470:   height: 1.3em;
                   5471:   vertical-align: text-bottom;
                   5472:   margin-right: 0.3em;
                   5473:   text-decoration:none;
                   5474: }
                   5475: 
1.1008    www      5476: .LC_setting {
                   5477:   text-decoration:underline;
                   5478: }
                   5479: 
1.350     albertel 5480: .LC_error {
                   5481:   color: red;
                   5482: }
1.795     www      5483: 
1.1075.2.15  raeburn  5484: .LC_warning {
                   5485:   color: darkorange;
                   5486: }
                   5487: 
1.457     albertel 5488: .LC_diff_removed {
1.733     bisitz   5489:   color: red;
1.394     albertel 5490: }
1.532     albertel 5491: 
                   5492: .LC_info,
1.457     albertel 5493: .LC_success,
                   5494: .LC_diff_added {
1.350     albertel 5495:   color: green;
                   5496: }
1.795     www      5497: 
1.802     bisitz   5498: div.LC_confirm_box {
                   5499:   background-color: #FAFAFA;
                   5500:   border: 1px solid $lg_border_color;
                   5501:   margin-right: 0;
                   5502:   padding: 5px;
                   5503: }
                   5504: 
                   5505: div.LC_confirm_box .LC_error img,
                   5506: div.LC_confirm_box .LC_success img {
                   5507:   vertical-align: middle;
                   5508: }
                   5509: 
1.440     albertel 5510: .LC_icon {
1.771     droeschl 5511:   border: none;
1.790     droeschl 5512:   vertical-align: middle;
1.771     droeschl 5513: }
                   5514: 
1.543     albertel 5515: .LC_docs_spacer {
                   5516:   width: 25px;
                   5517:   height: 1px;
1.771     droeschl 5518:   border: none;
1.543     albertel 5519: }
1.346     albertel 5520: 
1.532     albertel 5521: .LC_internal_info {
1.735     bisitz   5522:   color: #999999;
1.532     albertel 5523: }
                   5524: 
1.794     www      5525: .LC_discussion {
1.1050    www      5526:   background: $data_table_dark;
1.911     bisitz   5527:   border: 1px solid black;
                   5528:   margin: 2px;
1.794     www      5529: }
                   5530: 
                   5531: .LC_disc_action_left {
1.1050    www      5532:   background: $sidebg;
1.911     bisitz   5533:   text-align: left;
1.1050    www      5534:   padding: 4px;
                   5535:   margin: 2px;
1.794     www      5536: }
                   5537: 
                   5538: .LC_disc_action_right {
1.1050    www      5539:   background: $sidebg;
1.911     bisitz   5540:   text-align: right;
1.1050    www      5541:   padding: 4px;
                   5542:   margin: 2px;
1.794     www      5543: }
                   5544: 
                   5545: .LC_disc_new_item {
1.911     bisitz   5546:   background: white;
                   5547:   border: 2px solid red;
1.1050    www      5548:   margin: 4px;
                   5549:   padding: 4px;
1.794     www      5550: }
                   5551: 
                   5552: .LC_disc_old_item {
1.911     bisitz   5553:   background: white;
1.1050    www      5554:   margin: 4px;
                   5555:   padding: 4px;
1.794     www      5556: }
                   5557: 
1.458     albertel 5558: table.LC_pastsubmission {
                   5559:   border: 1px solid black;
                   5560:   margin: 2px;
                   5561: }
                   5562: 
1.924     bisitz   5563: table#LC_menubuttons {
1.345     albertel 5564:   width: 100%;
                   5565:   background: $pgbg;
1.392     albertel 5566:   border: 2px;
1.402     albertel 5567:   border-collapse: separate;
1.803     bisitz   5568:   padding: 0;
1.345     albertel 5569: }
1.392     albertel 5570: 
1.801     tempelho 5571: table#LC_title_bar a {
                   5572:   color: $fontmenu;
                   5573: }
1.836     bisitz   5574: 
1.807     droeschl 5575: table#LC_title_bar {
1.819     tempelho 5576:   clear: both;
1.836     bisitz   5577:   display: none;
1.807     droeschl 5578: }
                   5579: 
1.795     www      5580: table#LC_title_bar,
1.933     droeschl 5581: table.LC_breadcrumbs, /* obsolete? */
1.393     albertel 5582: table#LC_title_bar.LC_with_remote {
1.359     albertel 5583:   width: 100%;
1.392     albertel 5584:   border-color: $pgbg;
                   5585:   border-style: solid;
                   5586:   border-width: $border;
1.379     albertel 5587:   background: $pgbg;
1.801     tempelho 5588:   color: $fontmenu;
1.392     albertel 5589:   border-collapse: collapse;
1.803     bisitz   5590:   padding: 0;
1.819     tempelho 5591:   margin: 0;
1.359     albertel 5592: }
1.795     www      5593: 
1.933     droeschl 5594: ul.LC_breadcrumb_tools_outerlist {
1.913     droeschl 5595:     margin: 0;
                   5596:     padding: 0;
1.933     droeschl 5597:     position: relative;
                   5598:     list-style: none;
1.913     droeschl 5599: }
1.933     droeschl 5600: ul.LC_breadcrumb_tools_outerlist li {
1.913     droeschl 5601:     display: inline;
                   5602: }
1.933     droeschl 5603: 
                   5604: .LC_breadcrumb_tools_navigation {
1.913     droeschl 5605:     padding: 0;
1.933     droeschl 5606:     margin: 0;
                   5607:     float: left;
1.913     droeschl 5608: }
1.933     droeschl 5609: .LC_breadcrumb_tools_tools {
                   5610:     padding: 0;
                   5611:     margin: 0;
1.913     droeschl 5612:     float: right;
                   5613: }
                   5614: 
1.359     albertel 5615: table#LC_title_bar td {
                   5616:   background: $tabbg;
                   5617: }
1.795     www      5618: 
1.911     bisitz   5619: table#LC_menubuttons img {
1.803     bisitz   5620:   border: none;
1.346     albertel 5621: }
1.795     www      5622: 
1.842     droeschl 5623: .LC_breadcrumbs_component {
1.911     bisitz   5624:   float: right;
                   5625:   margin: 0 1em;
1.357     albertel 5626: }
1.842     droeschl 5627: .LC_breadcrumbs_component img {
1.911     bisitz   5628:   vertical-align: middle;
1.777     tempelho 5629: }
1.795     www      5630: 
1.383     albertel 5631: td.LC_table_cell_checkbox {
                   5632:   text-align: center;
                   5633: }
1.795     www      5634: 
                   5635: .LC_fontsize_small {
1.911     bisitz   5636:   font-size: 70%;
1.705     tempelho 5637: }
                   5638: 
1.844     bisitz   5639: #LC_breadcrumbs {
1.911     bisitz   5640:   clear:both;
                   5641:   background: $sidebg;
                   5642:   border-bottom: 1px solid $lg_border_color;
                   5643:   line-height: 2.5em;
1.933     droeschl 5644:   overflow: hidden;
1.911     bisitz   5645:   margin: 0;
                   5646:   padding: 0;
1.995     raeburn  5647:   text-align: left;
1.819     tempelho 5648: }
1.862     bisitz   5649: 
1.1075.2.16  raeburn  5650: .LC_head_subbox, .LC_actionbox {
1.911     bisitz   5651:   clear:both;
                   5652:   background: #F8F8F8; /* $sidebg; */
1.915     droeschl 5653:   border: 1px solid $sidebg;
1.1075.2.16  raeburn  5654:   margin: 0 0 10px 0;
1.966     bisitz   5655:   padding: 3px;
1.995     raeburn  5656:   text-align: left;
1.822     bisitz   5657: }
                   5658: 
1.795     www      5659: .LC_fontsize_medium {
1.911     bisitz   5660:   font-size: 85%;
1.705     tempelho 5661: }
                   5662: 
1.795     www      5663: .LC_fontsize_large {
1.911     bisitz   5664:   font-size: 120%;
1.705     tempelho 5665: }
                   5666: 
1.346     albertel 5667: .LC_menubuttons_inline_text {
                   5668:   color: $font;
1.698     harmsja  5669:   font-size: 90%;
1.701     harmsja  5670:   padding-left:3px;
1.346     albertel 5671: }
                   5672: 
1.934     droeschl 5673: .LC_menubuttons_inline_text img{
                   5674:   vertical-align: middle;
                   5675: }
                   5676: 
1.1051    www      5677: li.LC_menubuttons_inline_text img {
1.951     onken    5678:   cursor:pointer;
1.1002    droeschl 5679:   text-decoration: none;
1.951     onken    5680: }
                   5681: 
1.526     www      5682: .LC_menubuttons_link {
                   5683:   text-decoration: none;
                   5684: }
1.795     www      5685: 
1.522     albertel 5686: .LC_menubuttons_category {
1.521     www      5687:   color: $font;
1.526     www      5688:   background: $pgbg;
1.521     www      5689:   font-size: larger;
                   5690:   font-weight: bold;
                   5691: }
                   5692: 
1.346     albertel 5693: td.LC_menubuttons_text {
1.911     bisitz   5694:   color: $font;
1.346     albertel 5695: }
1.706     harmsja  5696: 
1.346     albertel 5697: .LC_current_location {
                   5698:   background: $tabbg;
                   5699: }
1.795     www      5700: 
1.938     bisitz   5701: table.LC_data_table {
1.347     albertel 5702:   border: 1px solid #000000;
1.402     albertel 5703:   border-collapse: separate;
1.426     albertel 5704:   border-spacing: 1px;
1.610     albertel 5705:   background: $pgbg;
1.347     albertel 5706: }
1.795     www      5707: 
1.422     albertel 5708: .LC_data_table_dense {
                   5709:   font-size: small;
                   5710: }
1.795     www      5711: 
1.507     raeburn  5712: table.LC_nested_outer {
                   5713:   border: 1px solid #000000;
1.589     raeburn  5714:   border-collapse: collapse;
1.803     bisitz   5715:   border-spacing: 0;
1.507     raeburn  5716:   width: 100%;
                   5717: }
1.795     www      5718: 
1.879     raeburn  5719: table.LC_innerpickbox,
1.507     raeburn  5720: table.LC_nested {
1.803     bisitz   5721:   border: none;
1.589     raeburn  5722:   border-collapse: collapse;
1.803     bisitz   5723:   border-spacing: 0;
1.507     raeburn  5724:   width: 100%;
                   5725: }
1.795     www      5726: 
1.911     bisitz   5727: table.LC_data_table tr th,
                   5728: table.LC_calendar tr th,
1.879     raeburn  5729: table.LC_prior_tries tr th,
                   5730: table.LC_innerpickbox tr th {
1.349     albertel 5731:   font-weight: bold;
                   5732:   background-color: $data_table_head;
1.801     tempelho 5733:   color:$fontmenu;
1.701     harmsja  5734:   font-size:90%;
1.347     albertel 5735: }
1.795     www      5736: 
1.879     raeburn  5737: table.LC_innerpickbox tr th,
                   5738: table.LC_innerpickbox tr td {
                   5739:   vertical-align: top;
                   5740: }
                   5741: 
1.711     raeburn  5742: table.LC_data_table tr.LC_info_row > td {
1.735     bisitz   5743:   background-color: #CCCCCC;
1.711     raeburn  5744:   font-weight: bold;
                   5745:   text-align: left;
                   5746: }
1.795     www      5747: 
1.912     bisitz   5748: table.LC_data_table tr.LC_odd_row > td {
                   5749:   background-color: $data_table_light;
                   5750:   padding: 2px;
                   5751:   vertical-align: top;
                   5752: }
                   5753: 
1.809     bisitz   5754: table.LC_pick_box tr > td.LC_odd_row {
1.349     albertel 5755:   background-color: $data_table_light;
1.912     bisitz   5756:   vertical-align: top;
                   5757: }
                   5758: 
                   5759: table.LC_data_table tr.LC_even_row > td {
                   5760:   background-color: $data_table_dark;
1.425     albertel 5761:   padding: 2px;
1.900     bisitz   5762:   vertical-align: top;
1.347     albertel 5763: }
1.795     www      5764: 
1.809     bisitz   5765: table.LC_pick_box tr > td.LC_even_row {
1.349     albertel 5766:   background-color: $data_table_dark;
1.900     bisitz   5767:   vertical-align: top;
1.347     albertel 5768: }
1.795     www      5769: 
1.425     albertel 5770: table.LC_data_table tr.LC_data_table_highlight td {
                   5771:   background-color: $data_table_darker;
                   5772: }
1.795     www      5773: 
1.639     raeburn  5774: table.LC_data_table tr td.LC_leftcol_header {
                   5775:   background-color: $data_table_head;
                   5776:   font-weight: bold;
                   5777: }
1.795     www      5778: 
1.451     albertel 5779: table.LC_data_table tr.LC_empty_row td,
1.507     raeburn  5780: table.LC_nested tr.LC_empty_row td {
1.421     albertel 5781:   font-weight: bold;
                   5782:   font-style: italic;
                   5783:   text-align: center;
                   5784:   padding: 8px;
1.347     albertel 5785: }
1.795     www      5786: 
1.1075.2.30  raeburn  5787: table.LC_data_table tr.LC_empty_row td,
                   5788: table.LC_data_table tr.LC_footer_row td {
1.940     bisitz   5789:   background-color: $sidebg;
                   5790: }
                   5791: 
                   5792: table.LC_nested tr.LC_empty_row td {
                   5793:   background-color: #FFFFFF;
                   5794: }
                   5795: 
1.890     droeschl 5796: table.LC_caption {
                   5797: }
                   5798: 
1.507     raeburn  5799: table.LC_nested tr.LC_empty_row td {
1.465     albertel 5800:   padding: 4ex
                   5801: }
1.795     www      5802: 
1.507     raeburn  5803: table.LC_nested_outer tr th {
                   5804:   font-weight: bold;
1.801     tempelho 5805:   color:$fontmenu;
1.507     raeburn  5806:   background-color: $data_table_head;
1.701     harmsja  5807:   font-size: small;
1.507     raeburn  5808:   border-bottom: 1px solid #000000;
                   5809: }
1.795     www      5810: 
1.507     raeburn  5811: table.LC_nested_outer tr td.LC_subheader {
                   5812:   background-color: $data_table_head;
                   5813:   font-weight: bold;
                   5814:   font-size: small;
                   5815:   border-bottom: 1px solid #000000;
                   5816:   text-align: right;
1.451     albertel 5817: }
1.795     www      5818: 
1.507     raeburn  5819: table.LC_nested tr.LC_info_row td {
1.735     bisitz   5820:   background-color: #CCCCCC;
1.451     albertel 5821:   font-weight: bold;
                   5822:   font-size: small;
1.507     raeburn  5823:   text-align: center;
                   5824: }
1.795     www      5825: 
1.589     raeburn  5826: table.LC_nested tr.LC_info_row td.LC_left_item,
                   5827: table.LC_nested_outer tr th.LC_left_item {
1.507     raeburn  5828:   text-align: left;
1.451     albertel 5829: }
1.795     www      5830: 
1.507     raeburn  5831: table.LC_nested td {
1.735     bisitz   5832:   background-color: #FFFFFF;
1.451     albertel 5833:   font-size: small;
1.507     raeburn  5834: }
1.795     www      5835: 
1.507     raeburn  5836: table.LC_nested_outer tr th.LC_right_item,
                   5837: table.LC_nested tr.LC_info_row td.LC_right_item,
                   5838: table.LC_nested tr.LC_odd_row td.LC_right_item,
                   5839: table.LC_nested tr td.LC_right_item {
1.451     albertel 5840:   text-align: right;
                   5841: }
                   5842: 
1.507     raeburn  5843: table.LC_nested tr.LC_odd_row td {
1.735     bisitz   5844:   background-color: #EEEEEE;
1.451     albertel 5845: }
                   5846: 
1.473     raeburn  5847: table.LC_createuser {
                   5848: }
                   5849: 
                   5850: table.LC_createuser tr.LC_section_row td {
1.701     harmsja  5851:   font-size: small;
1.473     raeburn  5852: }
                   5853: 
                   5854: table.LC_createuser tr.LC_info_row td  {
1.735     bisitz   5855:   background-color: #CCCCCC;
1.473     raeburn  5856:   font-weight: bold;
                   5857:   text-align: center;
                   5858: }
                   5859: 
1.349     albertel 5860: table.LC_calendar {
                   5861:   border: 1px solid #000000;
                   5862:   border-collapse: collapse;
1.917     raeburn  5863:   width: 98%;
1.349     albertel 5864: }
1.795     www      5865: 
1.349     albertel 5866: table.LC_calendar_pickdate {
                   5867:   font-size: xx-small;
                   5868: }
1.795     www      5869: 
1.349     albertel 5870: table.LC_calendar tr td {
                   5871:   border: 1px solid #000000;
                   5872:   vertical-align: top;
1.917     raeburn  5873:   width: 14%;
1.349     albertel 5874: }
1.795     www      5875: 
1.349     albertel 5876: table.LC_calendar tr td.LC_calendar_day_empty {
                   5877:   background-color: $data_table_dark;
                   5878: }
1.795     www      5879: 
1.779     bisitz   5880: table.LC_calendar tr td.LC_calendar_day_current {
                   5881:   background-color: $data_table_highlight;
1.777     tempelho 5882: }
1.795     www      5883: 
1.938     bisitz   5884: table.LC_data_table tr td.LC_mail_new {
1.349     albertel 5885:   background-color: $mail_new;
                   5886: }
1.795     www      5887: 
1.938     bisitz   5888: table.LC_data_table tr.LC_mail_new:hover {
1.349     albertel 5889:   background-color: $mail_new_hover;
                   5890: }
1.795     www      5891: 
1.938     bisitz   5892: table.LC_data_table tr td.LC_mail_read {
1.349     albertel 5893:   background-color: $mail_read;
                   5894: }
1.795     www      5895: 
1.938     bisitz   5896: /*
                   5897: table.LC_data_table tr.LC_mail_read:hover {
1.349     albertel 5898:   background-color: $mail_read_hover;
                   5899: }
1.938     bisitz   5900: */
1.795     www      5901: 
1.938     bisitz   5902: table.LC_data_table tr td.LC_mail_replied {
1.349     albertel 5903:   background-color: $mail_replied;
                   5904: }
1.795     www      5905: 
1.938     bisitz   5906: /*
                   5907: table.LC_data_table tr.LC_mail_replied:hover {
1.349     albertel 5908:   background-color: $mail_replied_hover;
                   5909: }
1.938     bisitz   5910: */
1.795     www      5911: 
1.938     bisitz   5912: table.LC_data_table tr td.LC_mail_other {
1.349     albertel 5913:   background-color: $mail_other;
                   5914: }
1.795     www      5915: 
1.938     bisitz   5916: /*
                   5917: table.LC_data_table tr.LC_mail_other:hover {
1.349     albertel 5918:   background-color: $mail_other_hover;
                   5919: }
1.938     bisitz   5920: */
1.494     raeburn  5921: 
1.777     tempelho 5922: table.LC_data_table tr > td.LC_browser_file,
                   5923: table.LC_data_table tr > td.LC_browser_file_published {
1.899     bisitz   5924:   background: #AAEE77;
1.389     albertel 5925: }
1.795     www      5926: 
1.777     tempelho 5927: table.LC_data_table tr > td.LC_browser_file_locked,
                   5928: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389     albertel 5929:   background: #FFAA99;
1.387     albertel 5930: }
1.795     www      5931: 
1.777     tempelho 5932: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899     bisitz   5933:   background: #888888;
1.779     bisitz   5934: }
1.795     www      5935: 
1.777     tempelho 5936: table.LC_data_table tr > td.LC_browser_file_modified,
1.779     bisitz   5937: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899     bisitz   5938:   background: #F8F866;
1.777     tempelho 5939: }
1.795     www      5940: 
1.696     bisitz   5941: table.LC_data_table tr.LC_browser_folder > td {
1.899     bisitz   5942:   background: #E0E8FF;
1.387     albertel 5943: }
1.696     bisitz   5944: 
1.707     bisitz   5945: table.LC_data_table tr > td.LC_roles_is {
1.911     bisitz   5946:   /* background: #77FF77; */
1.707     bisitz   5947: }
1.795     www      5948: 
1.707     bisitz   5949: table.LC_data_table tr > td.LC_roles_future {
1.939     bisitz   5950:   border-right: 8px solid #FFFF77;
1.707     bisitz   5951: }
1.795     www      5952: 
1.707     bisitz   5953: table.LC_data_table tr > td.LC_roles_will {
1.939     bisitz   5954:   border-right: 8px solid #FFAA77;
1.707     bisitz   5955: }
1.795     www      5956: 
1.707     bisitz   5957: table.LC_data_table tr > td.LC_roles_expired {
1.939     bisitz   5958:   border-right: 8px solid #FF7777;
1.707     bisitz   5959: }
1.795     www      5960: 
1.707     bisitz   5961: table.LC_data_table tr > td.LC_roles_will_not {
1.939     bisitz   5962:   border-right: 8px solid #AAFF77;
1.707     bisitz   5963: }
1.795     www      5964: 
1.707     bisitz   5965: table.LC_data_table tr > td.LC_roles_selected {
1.939     bisitz   5966:   border-right: 8px solid #11CC55;
1.707     bisitz   5967: }
                   5968: 
1.388     albertel 5969: span.LC_current_location {
1.701     harmsja  5970:   font-size:larger;
1.388     albertel 5971:   background: $pgbg;
                   5972: }
1.387     albertel 5973: 
1.1029    www      5974: span.LC_current_nav_location {
                   5975:   font-weight:bold;
                   5976:   background: $sidebg;
                   5977: }
                   5978: 
1.395     albertel 5979: span.LC_parm_menu_item {
                   5980:   font-size: larger;
                   5981: }
1.795     www      5982: 
1.395     albertel 5983: span.LC_parm_scope_all {
                   5984:   color: red;
                   5985: }
1.795     www      5986: 
1.395     albertel 5987: span.LC_parm_scope_folder {
                   5988:   color: green;
                   5989: }
1.795     www      5990: 
1.395     albertel 5991: span.LC_parm_scope_resource {
                   5992:   color: orange;
                   5993: }
1.795     www      5994: 
1.395     albertel 5995: span.LC_parm_part {
                   5996:   color: blue;
                   5997: }
1.795     www      5998: 
1.911     bisitz   5999: span.LC_parm_folder,
                   6000: span.LC_parm_symb {
1.395     albertel 6001:   font-size: x-small;
                   6002:   font-family: $mono;
                   6003:   color: #AAAAAA;
                   6004: }
                   6005: 
1.977     bisitz   6006: ul.LC_parm_parmlist li {
                   6007:   display: inline-block;
                   6008:   padding: 0.3em 0.8em;
                   6009:   vertical-align: top;
                   6010:   width: 150px;
                   6011:   border-top:1px solid $lg_border_color;
                   6012: }
                   6013: 
1.795     www      6014: td.LC_parm_overview_level_menu,
                   6015: td.LC_parm_overview_map_menu,
                   6016: td.LC_parm_overview_parm_selectors,
                   6017: td.LC_parm_overview_restrictions  {
1.396     albertel 6018:   border: 1px solid black;
                   6019:   border-collapse: collapse;
                   6020: }
1.795     www      6021: 
1.396     albertel 6022: table.LC_parm_overview_restrictions td {
                   6023:   border-width: 1px 4px 1px 4px;
                   6024:   border-style: solid;
                   6025:   border-color: $pgbg;
                   6026:   text-align: center;
                   6027: }
1.795     www      6028: 
1.396     albertel 6029: table.LC_parm_overview_restrictions th {
                   6030:   background: $tabbg;
                   6031:   border-width: 1px 4px 1px 4px;
                   6032:   border-style: solid;
                   6033:   border-color: $pgbg;
                   6034: }
1.795     www      6035: 
1.398     albertel 6036: table#LC_helpmenu {
1.803     bisitz   6037:   border: none;
1.398     albertel 6038:   height: 55px;
1.803     bisitz   6039:   border-spacing: 0;
1.398     albertel 6040: }
                   6041: 
                   6042: table#LC_helpmenu fieldset legend {
                   6043:   font-size: larger;
                   6044: }
1.795     www      6045: 
1.397     albertel 6046: table#LC_helpmenu_links {
                   6047:   width: 100%;
                   6048:   border: 1px solid black;
                   6049:   background: $pgbg;
1.803     bisitz   6050:   padding: 0;
1.397     albertel 6051:   border-spacing: 1px;
                   6052: }
1.795     www      6053: 
1.397     albertel 6054: table#LC_helpmenu_links tr td {
                   6055:   padding: 1px;
                   6056:   background: $tabbg;
1.399     albertel 6057:   text-align: center;
                   6058:   font-weight: bold;
1.397     albertel 6059: }
1.396     albertel 6060: 
1.795     www      6061: table#LC_helpmenu_links a:link,
                   6062: table#LC_helpmenu_links a:visited,
1.397     albertel 6063: table#LC_helpmenu_links a:active {
                   6064:   text-decoration: none;
                   6065:   color: $font;
                   6066: }
1.795     www      6067: 
1.397     albertel 6068: table#LC_helpmenu_links a:hover {
                   6069:   text-decoration: underline;
                   6070:   color: $vlink;
                   6071: }
1.396     albertel 6072: 
1.417     albertel 6073: .LC_chrt_popup_exists {
                   6074:   border: 1px solid #339933;
                   6075:   margin: -1px;
                   6076: }
1.795     www      6077: 
1.417     albertel 6078: .LC_chrt_popup_up {
                   6079:   border: 1px solid yellow;
                   6080:   margin: -1px;
                   6081: }
1.795     www      6082: 
1.417     albertel 6083: .LC_chrt_popup {
                   6084:   border: 1px solid #8888FF;
                   6085:   background: #CCCCFF;
                   6086: }
1.795     www      6087: 
1.421     albertel 6088: table.LC_pick_box {
                   6089:   border-collapse: separate;
                   6090:   background: white;
                   6091:   border: 1px solid black;
                   6092:   border-spacing: 1px;
                   6093: }
1.795     www      6094: 
1.421     albertel 6095: table.LC_pick_box td.LC_pick_box_title {
1.850     bisitz   6096:   background: $sidebg;
1.421     albertel 6097:   font-weight: bold;
1.900     bisitz   6098:   text-align: left;
1.740     bisitz   6099:   vertical-align: top;
1.421     albertel 6100:   width: 184px;
                   6101:   padding: 8px;
                   6102: }
1.795     www      6103: 
1.579     raeburn  6104: table.LC_pick_box td.LC_pick_box_value {
                   6105:   text-align: left;
                   6106:   padding: 8px;
                   6107: }
1.795     www      6108: 
1.579     raeburn  6109: table.LC_pick_box td.LC_pick_box_select {
                   6110:   text-align: left;
                   6111:   padding: 8px;
                   6112: }
1.795     www      6113: 
1.424     albertel 6114: table.LC_pick_box td.LC_pick_box_separator {
1.803     bisitz   6115:   padding: 0;
1.421     albertel 6116:   height: 1px;
                   6117:   background: black;
                   6118: }
1.795     www      6119: 
1.421     albertel 6120: table.LC_pick_box td.LC_pick_box_submit {
                   6121:   text-align: right;
                   6122: }
1.795     www      6123: 
1.579     raeburn  6124: table.LC_pick_box td.LC_evenrow_value {
                   6125:   text-align: left;
                   6126:   padding: 8px;
                   6127:   background-color: $data_table_light;
                   6128: }
1.795     www      6129: 
1.579     raeburn  6130: table.LC_pick_box td.LC_oddrow_value {
                   6131:   text-align: left;
                   6132:   padding: 8px;
                   6133:   background-color: $data_table_light;
                   6134: }
1.795     www      6135: 
1.579     raeburn  6136: span.LC_helpform_receipt_cat {
                   6137:   font-weight: bold;
                   6138: }
1.795     www      6139: 
1.424     albertel 6140: table.LC_group_priv_box {
                   6141:   background: white;
                   6142:   border: 1px solid black;
                   6143:   border-spacing: 1px;
                   6144: }
1.795     www      6145: 
1.424     albertel 6146: table.LC_group_priv_box td.LC_pick_box_title {
                   6147:   background: $tabbg;
                   6148:   font-weight: bold;
                   6149:   text-align: right;
                   6150:   width: 184px;
                   6151: }
1.795     www      6152: 
1.424     albertel 6153: table.LC_group_priv_box td.LC_groups_fixed {
                   6154:   background: $data_table_light;
                   6155:   text-align: center;
                   6156: }
1.795     www      6157: 
1.424     albertel 6158: table.LC_group_priv_box td.LC_groups_optional {
                   6159:   background: $data_table_dark;
                   6160:   text-align: center;
                   6161: }
1.795     www      6162: 
1.424     albertel 6163: table.LC_group_priv_box td.LC_groups_functionality {
                   6164:   background: $data_table_darker;
                   6165:   text-align: center;
                   6166:   font-weight: bold;
                   6167: }
1.795     www      6168: 
1.424     albertel 6169: table.LC_group_priv td {
                   6170:   text-align: left;
1.803     bisitz   6171:   padding: 0;
1.424     albertel 6172: }
                   6173: 
                   6174: .LC_navbuttons {
                   6175:   margin: 2ex 0ex 2ex 0ex;
                   6176: }
1.795     www      6177: 
1.423     albertel 6178: .LC_topic_bar {
                   6179:   font-weight: bold;
                   6180:   background: $tabbg;
1.918     wenzelju 6181:   margin: 1em 0em 1em 2em;
1.805     bisitz   6182:   padding: 3px;
1.918     wenzelju 6183:   font-size: 1.2em;
1.423     albertel 6184: }
1.795     www      6185: 
1.423     albertel 6186: .LC_topic_bar span {
1.918     wenzelju 6187:   left: 0.5em;
                   6188:   position: absolute;
1.423     albertel 6189:   vertical-align: middle;
1.918     wenzelju 6190:   font-size: 1.2em;
1.423     albertel 6191: }
1.795     www      6192: 
1.423     albertel 6193: table.LC_course_group_status {
                   6194:   margin: 20px;
                   6195: }
1.795     www      6196: 
1.423     albertel 6197: table.LC_status_selector td {
                   6198:   vertical-align: top;
                   6199:   text-align: center;
1.424     albertel 6200:   padding: 4px;
                   6201: }
1.795     www      6202: 
1.599     albertel 6203: div.LC_feedback_link {
1.616     albertel 6204:   clear: both;
1.829     kalberla 6205:   background: $sidebg;
1.779     bisitz   6206:   width: 100%;
1.829     kalberla 6207:   padding-bottom: 10px;
                   6208:   border: 1px $tabbg solid;
1.833     kalberla 6209:   height: 22px;
                   6210:   line-height: 22px;
                   6211:   padding-top: 5px;
                   6212: }
                   6213: 
                   6214: div.LC_feedback_link img {
                   6215:   height: 22px;
1.867     kalberla 6216:   vertical-align:middle;
1.829     kalberla 6217: }
                   6218: 
1.911     bisitz   6219: div.LC_feedback_link a {
1.829     kalberla 6220:   text-decoration: none;
1.489     raeburn  6221: }
1.795     www      6222: 
1.867     kalberla 6223: div.LC_comblock {
1.911     bisitz   6224:   display:inline;
1.867     kalberla 6225:   color:$font;
                   6226:   font-size:90%;
                   6227: }
                   6228: 
                   6229: div.LC_feedback_link div.LC_comblock {
                   6230:   padding-left:5px;
                   6231: }
                   6232: 
                   6233: div.LC_feedback_link div.LC_comblock a {
                   6234:   color:$font;
                   6235: }
                   6236: 
1.489     raeburn  6237: span.LC_feedback_link {
1.858     bisitz   6238:   /* background: $feedback_link_bg; */
1.599     albertel 6239:   font-size: larger;
                   6240: }
1.795     www      6241: 
1.599     albertel 6242: span.LC_message_link {
1.858     bisitz   6243:   /* background: $feedback_link_bg; */
1.599     albertel 6244:   font-size: larger;
                   6245:   position: absolute;
                   6246:   right: 1em;
1.489     raeburn  6247: }
1.421     albertel 6248: 
1.515     albertel 6249: table.LC_prior_tries {
1.524     albertel 6250:   border: 1px solid #000000;
                   6251:   border-collapse: separate;
                   6252:   border-spacing: 1px;
1.515     albertel 6253: }
1.523     albertel 6254: 
1.515     albertel 6255: table.LC_prior_tries td {
1.524     albertel 6256:   padding: 2px;
1.515     albertel 6257: }
1.523     albertel 6258: 
                   6259: .LC_answer_correct {
1.795     www      6260:   background: lightgreen;
                   6261:   color: darkgreen;
                   6262:   padding: 6px;
1.523     albertel 6263: }
1.795     www      6264: 
1.523     albertel 6265: .LC_answer_charged_try {
1.797     www      6266:   background: #FFAAAA;
1.795     www      6267:   color: darkred;
                   6268:   padding: 6px;
1.523     albertel 6269: }
1.795     www      6270: 
1.779     bisitz   6271: .LC_answer_not_charged_try,
1.523     albertel 6272: .LC_answer_no_grade,
                   6273: .LC_answer_late {
1.795     www      6274:   background: lightyellow;
1.523     albertel 6275:   color: black;
1.795     www      6276:   padding: 6px;
1.523     albertel 6277: }
1.795     www      6278: 
1.523     albertel 6279: .LC_answer_previous {
1.795     www      6280:   background: lightblue;
                   6281:   color: darkblue;
                   6282:   padding: 6px;
1.523     albertel 6283: }
1.795     www      6284: 
1.779     bisitz   6285: .LC_answer_no_message {
1.777     tempelho 6286:   background: #FFFFFF;
                   6287:   color: black;
1.795     www      6288:   padding: 6px;
1.779     bisitz   6289: }
1.795     www      6290: 
1.779     bisitz   6291: .LC_answer_unknown {
                   6292:   background: orange;
                   6293:   color: black;
1.795     www      6294:   padding: 6px;
1.777     tempelho 6295: }
1.795     www      6296: 
1.529     albertel 6297: span.LC_prior_numerical,
                   6298: span.LC_prior_string,
                   6299: span.LC_prior_custom,
                   6300: span.LC_prior_reaction,
                   6301: span.LC_prior_math {
1.925     bisitz   6302:   font-family: $mono;
1.523     albertel 6303:   white-space: pre;
                   6304: }
                   6305: 
1.525     albertel 6306: span.LC_prior_string {
1.925     bisitz   6307:   font-family: $mono;
1.525     albertel 6308:   white-space: pre;
                   6309: }
                   6310: 
1.523     albertel 6311: table.LC_prior_option {
                   6312:   width: 100%;
                   6313:   border-collapse: collapse;
                   6314: }
1.795     www      6315: 
1.911     bisitz   6316: table.LC_prior_rank,
1.795     www      6317: table.LC_prior_match {
1.528     albertel 6318:   border-collapse: collapse;
                   6319: }
1.795     www      6320: 
1.528     albertel 6321: table.LC_prior_option tr td,
                   6322: table.LC_prior_rank tr td,
                   6323: table.LC_prior_match tr td {
1.524     albertel 6324:   border: 1px solid #000000;
1.515     albertel 6325: }
                   6326: 
1.855     bisitz   6327: .LC_nobreak {
1.544     albertel 6328:   white-space: nowrap;
1.519     raeburn  6329: }
                   6330: 
1.576     raeburn  6331: span.LC_cusr_emph {
                   6332:   font-style: italic;
                   6333: }
                   6334: 
1.633     raeburn  6335: span.LC_cusr_subheading {
                   6336:   font-weight: normal;
                   6337:   font-size: 85%;
                   6338: }
                   6339: 
1.861     bisitz   6340: div.LC_docs_entry_move {
1.859     bisitz   6341:   border: 1px solid #BBBBBB;
1.545     albertel 6342:   background: #DDDDDD;
1.861     bisitz   6343:   width: 22px;
1.859     bisitz   6344:   padding: 1px;
                   6345:   margin: 0;
1.545     albertel 6346: }
                   6347: 
1.861     bisitz   6348: table.LC_data_table tr > td.LC_docs_entry_commands,
                   6349: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545     albertel 6350:   font-size: x-small;
                   6351: }
1.795     www      6352: 
1.861     bisitz   6353: .LC_docs_entry_parameter {
                   6354:   white-space: nowrap;
                   6355: }
                   6356: 
1.544     albertel 6357: .LC_docs_copy {
1.545     albertel 6358:   color: #000099;
1.544     albertel 6359: }
1.795     www      6360: 
1.544     albertel 6361: .LC_docs_cut {
1.545     albertel 6362:   color: #550044;
1.544     albertel 6363: }
1.795     www      6364: 
1.544     albertel 6365: .LC_docs_rename {
1.545     albertel 6366:   color: #009900;
1.544     albertel 6367: }
1.795     www      6368: 
1.544     albertel 6369: .LC_docs_remove {
1.545     albertel 6370:   color: #990000;
                   6371: }
                   6372: 
1.547     albertel 6373: .LC_docs_reinit_warn,
                   6374: .LC_docs_ext_edit {
                   6375:   font-size: x-small;
                   6376: }
                   6377: 
1.545     albertel 6378: table.LC_docs_adddocs td,
                   6379: table.LC_docs_adddocs th {
                   6380:   border: 1px solid #BBBBBB;
                   6381:   padding: 4px;
                   6382:   background: #DDDDDD;
1.543     albertel 6383: }
                   6384: 
1.584     albertel 6385: table.LC_sty_begin {
                   6386:   background: #BBFFBB;
                   6387: }
1.795     www      6388: 
1.584     albertel 6389: table.LC_sty_end {
                   6390:   background: #FFBBBB;
                   6391: }
                   6392: 
1.589     raeburn  6393: table.LC_double_column {
1.803     bisitz   6394:   border-width: 0;
1.589     raeburn  6395:   border-collapse: collapse;
                   6396:   width: 100%;
                   6397:   padding: 2px;
                   6398: }
                   6399: 
                   6400: table.LC_double_column tr td.LC_left_col {
1.590     raeburn  6401:   top: 2px;
1.589     raeburn  6402:   left: 2px;
                   6403:   width: 47%;
                   6404:   vertical-align: top;
                   6405: }
                   6406: 
                   6407: table.LC_double_column tr td.LC_right_col {
                   6408:   top: 2px;
1.779     bisitz   6409:   right: 2px;
1.589     raeburn  6410:   width: 47%;
                   6411:   vertical-align: top;
                   6412: }
                   6413: 
1.591     raeburn  6414: div.LC_left_float {
                   6415:   float: left;
                   6416:   padding-right: 5%;
1.597     albertel 6417:   padding-bottom: 4px;
1.591     raeburn  6418: }
                   6419: 
                   6420: div.LC_clear_float_header {
1.597     albertel 6421:   padding-bottom: 2px;
1.591     raeburn  6422: }
                   6423: 
                   6424: div.LC_clear_float_footer {
1.597     albertel 6425:   padding-top: 10px;
1.591     raeburn  6426:   clear: both;
                   6427: }
                   6428: 
1.597     albertel 6429: div.LC_grade_show_user {
1.941     bisitz   6430: /*  border-left: 5px solid $sidebg; */
                   6431:   border-top: 5px solid #000000;
                   6432:   margin: 50px 0 0 0;
1.936     bisitz   6433:   padding: 15px 0 5px 10px;
1.597     albertel 6434: }
1.795     www      6435: 
1.936     bisitz   6436: div.LC_grade_show_user_odd_row {
1.941     bisitz   6437: /*  border-left: 5px solid #000000; */
                   6438: }
                   6439: 
                   6440: div.LC_grade_show_user div.LC_Box {
                   6441:   margin-right: 50px;
1.597     albertel 6442: }
                   6443: 
                   6444: div.LC_grade_submissions,
                   6445: div.LC_grade_message_center,
1.936     bisitz   6446: div.LC_grade_info_links {
1.597     albertel 6447:   margin: 5px;
                   6448:   width: 99%;
                   6449:   background: #FFFFFF;
                   6450: }
1.795     www      6451: 
1.597     albertel 6452: div.LC_grade_submissions_header,
1.936     bisitz   6453: div.LC_grade_message_center_header {
1.705     tempelho 6454:   font-weight: bold;
                   6455:   font-size: large;
1.597     albertel 6456: }
1.795     www      6457: 
1.597     albertel 6458: div.LC_grade_submissions_body,
1.936     bisitz   6459: div.LC_grade_message_center_body {
1.597     albertel 6460:   border: 1px solid black;
                   6461:   width: 99%;
                   6462:   background: #FFFFFF;
                   6463: }
1.795     www      6464: 
1.613     albertel 6465: table.LC_scantron_action {
                   6466:   width: 100%;
                   6467: }
1.795     www      6468: 
1.613     albertel 6469: table.LC_scantron_action tr th {
1.698     harmsja  6470:   font-weight:bold;
                   6471:   font-style:normal;
1.613     albertel 6472: }
1.795     www      6473: 
1.779     bisitz   6474: .LC_edit_problem_header,
1.614     albertel 6475: div.LC_edit_problem_footer {
1.705     tempelho 6476:   font-weight: normal;
                   6477:   font-size:  medium;
1.602     albertel 6478:   margin: 2px;
1.1060    bisitz   6479:   background-color: $sidebg;
1.600     albertel 6480: }
1.795     www      6481: 
1.600     albertel 6482: div.LC_edit_problem_header,
1.602     albertel 6483: div.LC_edit_problem_header div,
1.614     albertel 6484: div.LC_edit_problem_footer,
                   6485: div.LC_edit_problem_footer div,
1.602     albertel 6486: div.LC_edit_problem_editxml_header,
                   6487: div.LC_edit_problem_editxml_header div {
1.600     albertel 6488:   margin-top: 5px;
                   6489: }
1.795     www      6490: 
1.600     albertel 6491: div.LC_edit_problem_header_title {
1.705     tempelho 6492:   font-weight: bold;
                   6493:   font-size: larger;
1.602     albertel 6494:   background: $tabbg;
                   6495:   padding: 3px;
1.1060    bisitz   6496:   margin: 0 0 5px 0;
1.602     albertel 6497: }
1.795     www      6498: 
1.602     albertel 6499: table.LC_edit_problem_header_title {
                   6500:   width: 100%;
1.600     albertel 6501:   background: $tabbg;
1.602     albertel 6502: }
                   6503: 
                   6504: div.LC_edit_problem_discards {
                   6505:   float: left;
                   6506:   padding-bottom: 5px;
                   6507: }
1.795     www      6508: 
1.602     albertel 6509: div.LC_edit_problem_saves {
                   6510:   float: right;
                   6511:   padding-bottom: 5px;
1.600     albertel 6512: }
1.795     www      6513: 
1.1075.2.34  raeburn  6514: .LC_edit_opt {
                   6515:   padding-left: 1em;
                   6516:   white-space: nowrap;
                   6517: }
                   6518: 
1.1075.2.57  raeburn  6519: .LC_edit_problem_latexhelper{
                   6520:     text-align: right;
                   6521: }
                   6522: 
                   6523: #LC_edit_problem_colorful div{
                   6524:     margin-left: 40px;
                   6525: }
                   6526: 
1.911     bisitz   6527: img.stift {
1.803     bisitz   6528:   border-width: 0;
                   6529:   vertical-align: middle;
1.677     riegler  6530: }
1.680     riegler  6531: 
1.923     bisitz   6532: table td.LC_mainmenu_col_fieldset {
1.680     riegler  6533:   vertical-align: top;
1.777     tempelho 6534: }
1.795     www      6535: 
1.716     raeburn  6536: div.LC_createcourse {
1.911     bisitz   6537:   margin: 10px 10px 10px 10px;
1.716     raeburn  6538: }
                   6539: 
1.917     raeburn  6540: .LC_dccid {
1.1075.2.38  raeburn  6541:   float: right;
1.917     raeburn  6542:   margin: 0.2em 0 0 0;
                   6543:   padding: 0;
                   6544:   font-size: 90%;
                   6545:   display:none;
                   6546: }
                   6547: 
1.897     wenzelju 6548: ol.LC_primary_menu a:hover,
1.721     harmsja  6549: ol#LC_MenuBreadcrumbs a:hover,
                   6550: ol#LC_PathBreadcrumbs a:hover,
1.897     wenzelju 6551: ul#LC_secondary_menu a:hover,
1.721     harmsja  6552: .LC_FormSectionClearButton input:hover
1.795     www      6553: ul.LC_TabContent   li:hover a {
1.952     onken    6554:   color:$button_hover;
1.911     bisitz   6555:   text-decoration:none;
1.693     droeschl 6556: }
                   6557: 
1.779     bisitz   6558: h1 {
1.911     bisitz   6559:   padding: 0;
                   6560:   line-height:130%;
1.693     droeschl 6561: }
1.698     harmsja  6562: 
1.911     bisitz   6563: h2,
                   6564: h3,
                   6565: h4,
                   6566: h5,
                   6567: h6 {
                   6568:   margin: 5px 0 5px 0;
                   6569:   padding: 0;
                   6570:   line-height:130%;
1.693     droeschl 6571: }
1.795     www      6572: 
                   6573: .LC_hcell {
1.911     bisitz   6574:   padding:3px 15px 3px 15px;
                   6575:   margin: 0;
                   6576:   background-color:$tabbg;
                   6577:   color:$fontmenu;
                   6578:   border-bottom:solid 1px $lg_border_color;
1.693     droeschl 6579: }
1.795     www      6580: 
1.840     bisitz   6581: .LC_Box > .LC_hcell {
1.911     bisitz   6582:   margin: 0 -10px 10px -10px;
1.835     bisitz   6583: }
                   6584: 
1.721     harmsja  6585: .LC_noBorder {
1.911     bisitz   6586:   border: 0;
1.698     harmsja  6587: }
1.693     droeschl 6588: 
1.721     harmsja  6589: .LC_FormSectionClearButton input {
1.911     bisitz   6590:   background-color:transparent;
                   6591:   border: none;
                   6592:   cursor:pointer;
                   6593:   text-decoration:underline;
1.693     droeschl 6594: }
1.763     bisitz   6595: 
                   6596: .LC_help_open_topic {
1.911     bisitz   6597:   color: #FFFFFF;
                   6598:   background-color: #EEEEFF;
                   6599:   margin: 1px;
                   6600:   padding: 4px;
                   6601:   border: 1px solid #000033;
                   6602:   white-space: nowrap;
                   6603:   /* vertical-align: middle; */
1.759     neumanie 6604: }
1.693     droeschl 6605: 
1.911     bisitz   6606: dl,
                   6607: ul,
                   6608: div,
                   6609: fieldset {
                   6610:   margin: 10px 10px 10px 0;
                   6611:   /* overflow: hidden; */
1.693     droeschl 6612: }
1.795     www      6613: 
1.838     bisitz   6614: fieldset > legend {
1.911     bisitz   6615:   font-weight: bold;
                   6616:   padding: 0 5px 0 5px;
1.838     bisitz   6617: }
                   6618: 
1.813     bisitz   6619: #LC_nav_bar {
1.911     bisitz   6620:   float: left;
1.995     raeburn  6621:   background-color: $pgbg_or_bgcolor;
1.966     bisitz   6622:   margin: 0 0 2px 0;
1.807     droeschl 6623: }
                   6624: 
1.916     droeschl 6625: #LC_realm {
                   6626:   margin: 0.2em 0 0 0;
                   6627:   padding: 0;
                   6628:   font-weight: bold;
                   6629:   text-align: center;
1.995     raeburn  6630:   background-color: $pgbg_or_bgcolor;
1.916     droeschl 6631: }
                   6632: 
1.911     bisitz   6633: #LC_nav_bar em {
                   6634:   font-weight: bold;
                   6635:   font-style: normal;
1.807     droeschl 6636: }
                   6637: 
1.897     wenzelju 6638: ol.LC_primary_menu {
1.934     droeschl 6639:   margin: 0;
1.1075.2.2  raeburn  6640:   padding: 0;
1.995     raeburn  6641:   background-color: $pgbg_or_bgcolor;
1.807     droeschl 6642: }
                   6643: 
1.852     droeschl 6644: ol#LC_PathBreadcrumbs {
1.911     bisitz   6645:   margin: 0;
1.693     droeschl 6646: }
                   6647: 
1.897     wenzelju 6648: ol.LC_primary_menu li {
1.1075.2.2  raeburn  6649:   color: RGB(80, 80, 80);
                   6650:   vertical-align: middle;
                   6651:   text-align: left;
                   6652:   list-style: none;
                   6653:   float: left;
                   6654: }
                   6655: 
                   6656: ol.LC_primary_menu li a {
                   6657:   display: block;
                   6658:   margin: 0;
                   6659:   padding: 0 5px 0 10px;
                   6660:   text-decoration: none;
                   6661: }
                   6662: 
                   6663: ol.LC_primary_menu li ul {
                   6664:   display: none;
                   6665:   width: 10em;
                   6666:   background-color: $data_table_light;
                   6667: }
                   6668: 
                   6669: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
                   6670:   display: block;
                   6671:   position: absolute;
                   6672:   margin: 0;
                   6673:   padding: 0;
1.1075.2.5  raeburn  6674:   z-index: 2;
1.1075.2.2  raeburn  6675: }
                   6676: 
                   6677: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
                   6678:   font-size: 90%;
1.911     bisitz   6679:   vertical-align: top;
1.1075.2.2  raeburn  6680:   float: none;
1.1075.2.5  raeburn  6681:   border-left: 1px solid black;
                   6682:   border-right: 1px solid black;
1.1075.2.2  raeburn  6683: }
                   6684: 
                   6685: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5  raeburn  6686:   background-color:$data_table_light;
1.1075.2.2  raeburn  6687: }
                   6688: 
                   6689: ol.LC_primary_menu li li a:hover {
                   6690:    color:$button_hover;
                   6691:    background-color:$data_table_dark;
1.693     droeschl 6692: }
                   6693: 
1.897     wenzelju 6694: ol.LC_primary_menu li img {
1.911     bisitz   6695:   vertical-align: bottom;
1.934     droeschl 6696:   height: 1.1em;
1.1075.2.3  raeburn  6697:   margin: 0.2em 0 0 0;
1.693     droeschl 6698: }
                   6699: 
1.897     wenzelju 6700: ol.LC_primary_menu a {
1.911     bisitz   6701:   color: RGB(80, 80, 80);
                   6702:   text-decoration: none;
1.693     droeschl 6703: }
1.795     www      6704: 
1.949     droeschl 6705: ol.LC_primary_menu a.LC_new_message {
                   6706:   font-weight:bold;
                   6707:   color: darkred;
                   6708: }
                   6709: 
1.975     raeburn  6710: ol.LC_docs_parameters {
                   6711:   margin-left: 0;
                   6712:   padding: 0;
                   6713:   list-style: none;
                   6714: }
                   6715: 
                   6716: ol.LC_docs_parameters li {
                   6717:   margin: 0;
                   6718:   padding-right: 20px;
                   6719:   display: inline;
                   6720: }
                   6721: 
1.976     raeburn  6722: ol.LC_docs_parameters li:before {
                   6723:   content: "\\002022 \\0020";
                   6724: }
                   6725: 
                   6726: li.LC_docs_parameters_title {
                   6727:   font-weight: bold;
                   6728: }
                   6729: 
                   6730: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
                   6731:   content: "";
                   6732: }
                   6733: 
1.897     wenzelju 6734: ul#LC_secondary_menu {
1.1075.2.23  raeburn  6735:   clear: right;
1.911     bisitz   6736:   color: $fontmenu;
                   6737:   background: $tabbg;
                   6738:   list-style: none;
                   6739:   padding: 0;
                   6740:   margin: 0;
                   6741:   width: 100%;
1.995     raeburn  6742:   text-align: left;
1.1075.2.4  raeburn  6743:   float: left;
1.808     droeschl 6744: }
                   6745: 
1.897     wenzelju 6746: ul#LC_secondary_menu li {
1.911     bisitz   6747:   font-weight: bold;
                   6748:   line-height: 1.8em;
                   6749:   border-right: 1px solid black;
                   6750:   vertical-align: middle;
1.1075.2.4  raeburn  6751:   float: left;
                   6752: }
                   6753: 
                   6754: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
                   6755:   background-color: $data_table_light;
                   6756: }
                   6757: 
                   6758: ul#LC_secondary_menu li a {
                   6759:   padding: 0 0.8em;
                   6760: }
                   6761: 
                   6762: ul#LC_secondary_menu li ul {
                   6763:   display: none;
                   6764: }
                   6765: 
                   6766: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
                   6767:   display: block;
                   6768:   position: absolute;
                   6769:   margin: 0;
                   6770:   padding: 0;
                   6771:   list-style:none;
                   6772:   float: none;
                   6773:   background-color: $data_table_light;
1.1075.2.5  raeburn  6774:   z-index: 2;
1.1075.2.10  raeburn  6775:   margin-left: -1px;
1.1075.2.4  raeburn  6776: }
                   6777: 
                   6778: ul#LC_secondary_menu li ul li {
                   6779:   font-size: 90%;
                   6780:   vertical-align: top;
                   6781:   border-left: 1px solid black;
                   6782:   border-right: 1px solid black;
1.1075.2.33  raeburn  6783:   background-color: $data_table_light;
1.1075.2.4  raeburn  6784:   list-style:none;
                   6785:   float: none;
                   6786: }
                   6787: 
                   6788: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
                   6789:   background-color: $data_table_dark;
1.807     droeschl 6790: }
                   6791: 
1.847     tempelho 6792: ul.LC_TabContent {
1.911     bisitz   6793:   display:block;
                   6794:   background: $sidebg;
                   6795:   border-bottom: solid 1px $lg_border_color;
                   6796:   list-style:none;
1.1020    raeburn  6797:   margin: -1px -10px 0 -10px;
1.911     bisitz   6798:   padding: 0;
1.693     droeschl 6799: }
                   6800: 
1.795     www      6801: ul.LC_TabContent li,
                   6802: ul.LC_TabContentBigger li {
1.911     bisitz   6803:   float:left;
1.741     harmsja  6804: }
1.795     www      6805: 
1.897     wenzelju 6806: ul#LC_secondary_menu li a {
1.911     bisitz   6807:   color: $fontmenu;
                   6808:   text-decoration: none;
1.693     droeschl 6809: }
1.795     www      6810: 
1.721     harmsja  6811: ul.LC_TabContent {
1.952     onken    6812:   min-height:20px;
1.721     harmsja  6813: }
1.795     www      6814: 
                   6815: ul.LC_TabContent li {
1.911     bisitz   6816:   vertical-align:middle;
1.959     onken    6817:   padding: 0 16px 0 10px;
1.911     bisitz   6818:   background-color:$tabbg;
                   6819:   border-bottom:solid 1px $lg_border_color;
1.1020    raeburn  6820:   border-left: solid 1px $font;
1.721     harmsja  6821: }
1.795     www      6822: 
1.847     tempelho 6823: ul.LC_TabContent .right {
1.911     bisitz   6824:   float:right;
1.847     tempelho 6825: }
                   6826: 
1.911     bisitz   6827: ul.LC_TabContent li a,
                   6828: ul.LC_TabContent li {
                   6829:   color:rgb(47,47,47);
                   6830:   text-decoration:none;
                   6831:   font-size:95%;
                   6832:   font-weight:bold;
1.952     onken    6833:   min-height:20px;
                   6834: }
                   6835: 
1.959     onken    6836: ul.LC_TabContent li a:hover,
                   6837: ul.LC_TabContent li a:focus {
1.952     onken    6838:   color: $button_hover;
1.959     onken    6839:   background:none;
                   6840:   outline:none;
1.952     onken    6841: }
                   6842: 
                   6843: ul.LC_TabContent li:hover {
                   6844:   color: $button_hover;
                   6845:   cursor:pointer;
1.721     harmsja  6846: }
1.795     www      6847: 
1.911     bisitz   6848: ul.LC_TabContent li.active {
1.952     onken    6849:   color: $font;
1.911     bisitz   6850:   background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952     onken    6851:   border-bottom:solid 1px #FFFFFF;
                   6852:   cursor: default;
1.744     ehlerst  6853: }
1.795     www      6854: 
1.959     onken    6855: ul.LC_TabContent li.active a {
                   6856:   color:$font;
                   6857:   background:#FFFFFF;
                   6858:   outline: none;
                   6859: }
1.1047    raeburn  6860: 
                   6861: ul.LC_TabContent li.goback {
                   6862:   float: left;
                   6863:   border-left: none;
                   6864: }
                   6865: 
1.870     tempelho 6866: #maincoursedoc {
1.911     bisitz   6867:   clear:both;
1.870     tempelho 6868: }
                   6869: 
                   6870: ul.LC_TabContentBigger {
1.911     bisitz   6871:   display:block;
                   6872:   list-style:none;
                   6873:   padding: 0;
1.870     tempelho 6874: }
                   6875: 
1.795     www      6876: ul.LC_TabContentBigger li {
1.911     bisitz   6877:   vertical-align:bottom;
                   6878:   height: 30px;
                   6879:   font-size:110%;
                   6880:   font-weight:bold;
                   6881:   color: #737373;
1.841     tempelho 6882: }
                   6883: 
1.957     onken    6884: ul.LC_TabContentBigger li.active {
                   6885:   position: relative;
                   6886:   top: 1px;
                   6887: }
                   6888: 
1.870     tempelho 6889: ul.LC_TabContentBigger li a {
1.911     bisitz   6890:   background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
                   6891:   height: 30px;
                   6892:   line-height: 30px;
                   6893:   text-align: center;
                   6894:   display: block;
                   6895:   text-decoration: none;
1.958     onken    6896:   outline: none;  
1.741     harmsja  6897: }
1.795     www      6898: 
1.870     tempelho 6899: ul.LC_TabContentBigger li.active a {
1.911     bisitz   6900:   background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
                   6901:   color:$font;
1.744     ehlerst  6902: }
1.795     www      6903: 
1.870     tempelho 6904: ul.LC_TabContentBigger li b {
1.911     bisitz   6905:   background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
                   6906:   display: block;
                   6907:   float: left;
                   6908:   padding: 0 30px;
1.957     onken    6909:   border-bottom: 1px solid $lg_border_color;
1.870     tempelho 6910: }
                   6911: 
1.956     onken    6912: ul.LC_TabContentBigger li:hover b {
                   6913:   color:$button_hover;
                   6914: }
                   6915: 
1.870     tempelho 6916: ul.LC_TabContentBigger li.active b {
1.911     bisitz   6917:   background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
                   6918:   color:$font;
1.957     onken    6919:   border: 0;
1.741     harmsja  6920: }
1.693     droeschl 6921: 
1.870     tempelho 6922: 
1.862     bisitz   6923: ul.LC_CourseBreadcrumbs {
                   6924:   background: $sidebg;
1.1020    raeburn  6925:   height: 2em;
1.862     bisitz   6926:   padding-left: 10px;
1.1020    raeburn  6927:   margin: 0;
1.862     bisitz   6928:   list-style-position: inside;
                   6929: }
                   6930: 
1.911     bisitz   6931: ol#LC_MenuBreadcrumbs,
1.862     bisitz   6932: ol#LC_PathBreadcrumbs {
1.911     bisitz   6933:   padding-left: 10px;
                   6934:   margin: 0;
1.933     droeschl 6935:   height: 2.5em;  /* equal to #LC_breadcrumbs line-height */
1.693     droeschl 6936: }
                   6937: 
1.911     bisitz   6938: ol#LC_MenuBreadcrumbs li,
                   6939: ol#LC_PathBreadcrumbs li,
1.862     bisitz   6940: ul.LC_CourseBreadcrumbs li {
1.911     bisitz   6941:   display: inline;
1.933     droeschl 6942:   white-space: normal;  
1.693     droeschl 6943: }
                   6944: 
1.823     bisitz   6945: ol#LC_MenuBreadcrumbs li a,
1.862     bisitz   6946: ul.LC_CourseBreadcrumbs li a {
1.911     bisitz   6947:   text-decoration: none;
                   6948:   font-size:90%;
1.693     droeschl 6949: }
1.795     www      6950: 
1.969     droeschl 6951: ol#LC_MenuBreadcrumbs h1 {
                   6952:   display: inline;
                   6953:   font-size: 90%;
                   6954:   line-height: 2.5em;
                   6955:   margin: 0;
                   6956:   padding: 0;
                   6957: }
                   6958: 
1.795     www      6959: ol#LC_PathBreadcrumbs li a {
1.911     bisitz   6960:   text-decoration:none;
                   6961:   font-size:100%;
                   6962:   font-weight:bold;
1.693     droeschl 6963: }
1.795     www      6964: 
1.840     bisitz   6965: .LC_Box {
1.911     bisitz   6966:   border: solid 1px $lg_border_color;
                   6967:   padding: 0 10px 10px 10px;
1.746     neumanie 6968: }
1.795     www      6969: 
1.1020    raeburn  6970: .LC_DocsBox {
                   6971:   border: solid 1px $lg_border_color;
                   6972:   padding: 0 0 10px 10px;
                   6973: }
                   6974: 
1.795     www      6975: .LC_AboutMe_Image {
1.911     bisitz   6976:   float:left;
                   6977:   margin-right:10px;
1.747     neumanie 6978: }
1.795     www      6979: 
                   6980: .LC_Clear_AboutMe_Image {
1.911     bisitz   6981:   clear:left;
1.747     neumanie 6982: }
1.795     www      6983: 
1.721     harmsja  6984: dl.LC_ListStyleClean dt {
1.911     bisitz   6985:   padding-right: 5px;
                   6986:   display: table-header-group;
1.693     droeschl 6987: }
                   6988: 
1.721     harmsja  6989: dl.LC_ListStyleClean dd {
1.911     bisitz   6990:   display: table-row;
1.693     droeschl 6991: }
                   6992: 
1.721     harmsja  6993: .LC_ListStyleClean,
                   6994: .LC_ListStyleSimple,
                   6995: .LC_ListStyleNormal,
1.795     www      6996: .LC_ListStyleSpecial {
1.911     bisitz   6997:   /* display:block; */
                   6998:   list-style-position: inside;
                   6999:   list-style-type: none;
                   7000:   overflow: hidden;
                   7001:   padding: 0;
1.693     droeschl 7002: }
                   7003: 
1.721     harmsja  7004: .LC_ListStyleSimple li,
                   7005: .LC_ListStyleSimple dd,
                   7006: .LC_ListStyleNormal li,
                   7007: .LC_ListStyleNormal dd,
                   7008: .LC_ListStyleSpecial li,
1.795     www      7009: .LC_ListStyleSpecial dd {
1.911     bisitz   7010:   margin: 0;
                   7011:   padding: 5px 5px 5px 10px;
                   7012:   clear: both;
1.693     droeschl 7013: }
                   7014: 
1.721     harmsja  7015: .LC_ListStyleClean li,
                   7016: .LC_ListStyleClean dd {
1.911     bisitz   7017:   padding-top: 0;
                   7018:   padding-bottom: 0;
1.693     droeschl 7019: }
                   7020: 
1.721     harmsja  7021: .LC_ListStyleSimple dd,
1.795     www      7022: .LC_ListStyleSimple li {
1.911     bisitz   7023:   border-bottom: solid 1px $lg_border_color;
1.693     droeschl 7024: }
                   7025: 
1.721     harmsja  7026: .LC_ListStyleSpecial li,
                   7027: .LC_ListStyleSpecial dd {
1.911     bisitz   7028:   list-style-type: none;
                   7029:   background-color: RGB(220, 220, 220);
                   7030:   margin-bottom: 4px;
1.693     droeschl 7031: }
                   7032: 
1.721     harmsja  7033: table.LC_SimpleTable {
1.911     bisitz   7034:   margin:5px;
                   7035:   border:solid 1px $lg_border_color;
1.795     www      7036: }
1.693     droeschl 7037: 
1.721     harmsja  7038: table.LC_SimpleTable tr {
1.911     bisitz   7039:   padding: 0;
                   7040:   border:solid 1px $lg_border_color;
1.693     droeschl 7041: }
1.795     www      7042: 
                   7043: table.LC_SimpleTable thead {
1.911     bisitz   7044:   background:rgb(220,220,220);
1.693     droeschl 7045: }
                   7046: 
1.721     harmsja  7047: div.LC_columnSection {
1.911     bisitz   7048:   display: block;
                   7049:   clear: both;
                   7050:   overflow: hidden;
                   7051:   margin: 0;
1.693     droeschl 7052: }
                   7053: 
1.721     harmsja  7054: div.LC_columnSection>* {
1.911     bisitz   7055:   float: left;
                   7056:   margin: 10px 20px 10px 0;
                   7057:   overflow:hidden;
1.693     droeschl 7058: }
1.721     harmsja  7059: 
1.795     www      7060: table em {
1.911     bisitz   7061:   font-weight: bold;
                   7062:   font-style: normal;
1.748     schulted 7063: }
1.795     www      7064: 
1.779     bisitz   7065: table.LC_tableBrowseRes,
1.795     www      7066: table.LC_tableOfContent {
1.911     bisitz   7067:   border:none;
                   7068:   border-spacing: 1px;
                   7069:   padding: 3px;
                   7070:   background-color: #FFFFFF;
                   7071:   font-size: 90%;
1.753     droeschl 7072: }
1.789     droeschl 7073: 
1.911     bisitz   7074: table.LC_tableOfContent {
                   7075:   border-collapse: collapse;
1.789     droeschl 7076: }
                   7077: 
1.771     droeschl 7078: table.LC_tableBrowseRes a,
1.768     schulted 7079: table.LC_tableOfContent a {
1.911     bisitz   7080:   background-color: transparent;
                   7081:   text-decoration: none;
1.753     droeschl 7082: }
                   7083: 
1.795     www      7084: table.LC_tableOfContent img {
1.911     bisitz   7085:   border: none;
                   7086:   height: 1.3em;
                   7087:   vertical-align: text-bottom;
                   7088:   margin-right: 0.3em;
1.753     droeschl 7089: }
1.757     schulted 7090: 
1.795     www      7091: a#LC_content_toolbar_firsthomework {
1.911     bisitz   7092:   background-image:url(/res/adm/pages/open-first-problem.gif);
1.774     ehlerst  7093: }
                   7094: 
1.795     www      7095: a#LC_content_toolbar_everything {
1.911     bisitz   7096:   background-image:url(/res/adm/pages/show-all.gif);
1.774     ehlerst  7097: }
                   7098: 
1.795     www      7099: a#LC_content_toolbar_uncompleted {
1.911     bisitz   7100:   background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774     ehlerst  7101: }
                   7102: 
1.795     www      7103: #LC_content_toolbar_clearbubbles {
1.911     bisitz   7104:   background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774     ehlerst  7105: }
                   7106: 
1.795     www      7107: a#LC_content_toolbar_changefolder {
1.911     bisitz   7108:   background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757     schulted 7109: }
                   7110: 
1.795     www      7111: a#LC_content_toolbar_changefolder_toggled {
1.911     bisitz   7112:   background-image:url(/res/adm/pages/open-all-folders.gif);
1.757     schulted 7113: }
                   7114: 
1.1043    raeburn  7115: a#LC_content_toolbar_edittoplevel {
                   7116:   background-image:url(/res/adm/pages/edittoplevel.gif);
                   7117: }
                   7118: 
1.795     www      7119: ul#LC_toolbar li a:hover {
1.911     bisitz   7120:   background-position: bottom center;
1.757     schulted 7121: }
                   7122: 
1.795     www      7123: ul#LC_toolbar {
1.911     bisitz   7124:   padding: 0;
                   7125:   margin: 2px;
                   7126:   list-style:none;
                   7127:   position:relative;
                   7128:   background-color:white;
1.1075.2.9  raeburn  7129:   overflow: auto;
1.757     schulted 7130: }
                   7131: 
1.795     www      7132: ul#LC_toolbar li {
1.911     bisitz   7133:   border:1px solid white;
                   7134:   padding: 0;
                   7135:   margin: 0;
                   7136:   float: left;
                   7137:   display:inline;
                   7138:   vertical-align:middle;
1.1075.2.9  raeburn  7139:   white-space: nowrap;
1.911     bisitz   7140: }
1.757     schulted 7141: 
1.783     amueller 7142: 
1.795     www      7143: a.LC_toolbarItem {
1.911     bisitz   7144:   display:block;
                   7145:   padding: 0;
                   7146:   margin: 0;
                   7147:   height: 32px;
                   7148:   width: 32px;
                   7149:   color:white;
                   7150:   border: none;
                   7151:   background-repeat:no-repeat;
                   7152:   background-color:transparent;
1.757     schulted 7153: }
                   7154: 
1.915     droeschl 7155: ul.LC_funclist {
                   7156:     margin: 0;
                   7157:     padding: 0.5em 1em 0.5em 0;
                   7158: }
                   7159: 
1.933     droeschl 7160: ul.LC_funclist > li:first-child {
                   7161:     font-weight:bold; 
                   7162:     margin-left:0.8em;
                   7163: }
                   7164: 
1.915     droeschl 7165: ul.LC_funclist + ul.LC_funclist {
                   7166:     /* 
                   7167:        left border as a seperator if we have more than
                   7168:        one list 
                   7169:     */
                   7170:     border-left: 1px solid $sidebg;
                   7171:     /* 
                   7172:        this hides the left border behind the border of the 
                   7173:        outer box if element is wrapped to the next 'line' 
                   7174:     */
                   7175:     margin-left: -1px;
                   7176: }
                   7177: 
1.843     bisitz   7178: ul.LC_funclist li {
1.915     droeschl 7179:   display: inline;
1.782     bisitz   7180:   white-space: nowrap;
1.915     droeschl 7181:   margin: 0 0 0 25px;
                   7182:   line-height: 150%;
1.782     bisitz   7183: }
                   7184: 
1.974     wenzelju 7185: .LC_hidden {
                   7186:   display: none;
                   7187: }
                   7188: 
1.1030    www      7189: .LCmodal-overlay {
                   7190: 		position:fixed;
                   7191: 		top:0;
                   7192: 		right:0;
                   7193: 		bottom:0;
                   7194: 		left:0;
                   7195: 		height:100%;
                   7196: 		width:100%;
                   7197: 		margin:0;
                   7198: 		padding:0;
                   7199: 		background:#999;
                   7200: 		opacity:.75;
                   7201: 		filter: alpha(opacity=75);
                   7202: 		-moz-opacity: 0.75;
                   7203: 		z-index:101;
                   7204: }
                   7205: 
                   7206: * html .LCmodal-overlay {   
                   7207: 		position: absolute;
                   7208: 		height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
                   7209: }
                   7210: 
                   7211: .LCmodal-window {
                   7212: 		position:fixed;
                   7213: 		top:50%;
                   7214: 		left:50%;
                   7215: 		margin:0;
                   7216: 		padding:0;
                   7217: 		z-index:102;
                   7218: 	}
                   7219: 
                   7220: * html .LCmodal-window {
                   7221: 		position:absolute;
                   7222: }
                   7223: 
                   7224: .LCclose-window {
                   7225: 		position:absolute;
                   7226: 		width:32px;
                   7227: 		height:32px;
                   7228: 		right:8px;
                   7229: 		top:8px;
                   7230: 		background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
                   7231: 		text-indent:-99999px;
                   7232: 		overflow:hidden;
                   7233: 		cursor:pointer;
                   7234: }
                   7235: 
1.1075.2.17  raeburn  7236: /*
                   7237:   styles used by TTH when "Default set of options to pass to tth/m
                   7238:   when converting TeX" in course settings has been set
                   7239: 
                   7240:   option passed: -t
                   7241: 
                   7242: */
                   7243: 
                   7244: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
                   7245: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
                   7246: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
                   7247: td div.norm {line-height:normal;}
                   7248: 
                   7249: /*
                   7250:   option passed -y3
                   7251: */
                   7252: 
                   7253: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
                   7254: span.overacc2 {position: relative;  left: .8em; top: -1.2ex;}
                   7255: span.overacc1 {position: relative;  left: .6em; top: -1.2ex;}
                   7256: 
1.343     albertel 7257: END
                   7258: }
                   7259: 
1.306     albertel 7260: =pod
                   7261: 
                   7262: =item * &headtag()
                   7263: 
                   7264: Returns a uniform footer for LON-CAPA web pages.
                   7265: 
1.307     albertel 7266: Inputs: $title - optional title for the head
                   7267:         $head_extra - optional extra HTML to put inside the <head>
1.315     albertel 7268:         $args - optional arguments
1.319     albertel 7269:             force_register - if is true call registerurl so the remote is 
                   7270:                              informed
1.415     albertel 7271:             redirect       -> array ref of
                   7272:                                    1- seconds before redirect occurs
                   7273:                                    2- url to redirect to
                   7274:                                    3- whether the side effect should occur
1.315     albertel 7275:                            (side effect of setting 
                   7276:                                $env{'internal.head.redirect'} to the url 
                   7277:                                redirected too)
1.352     albertel 7278:             domain         -> force to color decorate a page for a specific
                   7279:                                domain
                   7280:             function       -> force usage of a specific rolish color scheme
                   7281:             bgcolor        -> override the default page bgcolor
1.460     albertel 7282:             no_auto_mt_title
                   7283:                            -> prevent &mt()ing the title arg
1.464     albertel 7284: 
1.306     albertel 7285: =cut
                   7286: 
                   7287: sub headtag {
1.313     albertel 7288:     my ($title,$head_extra,$args) = @_;
1.306     albertel 7289:     
1.363     albertel 7290:     my $function = $args->{'function'} || &get_users_function();
                   7291:     my $domain   = $args->{'domain'}   || &determinedomain();
                   7292:     my $bgcolor  = $args->{'bgcolor'}  || &designparm($function.'.pgbg',$domain);
1.1075.2.52  raeburn  7293:     my $httphost = $args->{'use_absolute'};
1.418     albertel 7294:     my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458     albertel 7295: 		   $Apache::lonnet::perlvar{'lonVersion'},
1.531     albertel 7296: 		   #time(),
1.418     albertel 7297: 		   $env{'environment.color.timestamp'},
1.363     albertel 7298: 		   $function,$domain,$bgcolor);
                   7299: 
1.369     www      7300:     $url = '/adm/css/'.&escape($url).'.css';
1.363     albertel 7301: 
1.308     albertel 7302:     my $result =
                   7303: 	'<head>'.
1.1075.2.56  raeburn  7304: 	&font_settings($args);
1.319     albertel 7305: 
1.1075.2.72  raeburn  7306:     my $inhibitprint;
                   7307:     if ($args->{'print_suppress'}) {
                   7308:         $inhibitprint = &print_suppression();
                   7309:     }
1.1064    raeburn  7310: 
1.461     albertel 7311:     if (!$args->{'frameset'}) {
                   7312: 	$result .= &Apache::lonhtmlcommon::htmlareaheaders();
                   7313:     }
1.1075.2.12  raeburn  7314:     if ($args->{'force_register'}) {
                   7315:         $result .= &Apache::lonmenu::registerurl(1);
1.319     albertel 7316:     }
1.436     albertel 7317:     if (!$args->{'no_nav_bar'} 
                   7318: 	&& !$args->{'only_body'}
                   7319: 	&& !$args->{'frameset'}) {
1.1075.2.52  raeburn  7320: 	$result .= &help_menu_js($httphost);
1.1032    www      7321:         $result.=&modal_window();
1.1038    www      7322:         $result.=&togglebox_script();
1.1034    www      7323:         $result.=&wishlist_window();
1.1041    www      7324:         $result.=&LCprogressbarUpdate_script();
1.1034    www      7325:     } else {
                   7326:         if ($args->{'add_modal'}) {
                   7327:            $result.=&modal_window();
                   7328:         }
                   7329:         if ($args->{'add_wishlist'}) {
                   7330:            $result.=&wishlist_window();
                   7331:         }
1.1038    www      7332:         if ($args->{'add_togglebox'}) {
                   7333:            $result.=&togglebox_script();
                   7334:         }
1.1041    www      7335:         if ($args->{'add_progressbar'}) {
                   7336:            $result.=&LCprogressbarUpdate_script();
                   7337:         }
1.436     albertel 7338:     }
1.314     albertel 7339:     if (ref($args->{'redirect'})) {
1.414     albertel 7340: 	my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315     albertel 7341: 	$url = &Apache::lonenc::check_encrypt($url);
1.414     albertel 7342: 	if (!$inhibit_continue) {
                   7343: 	    $env{'internal.head.redirect'} = $url;
                   7344: 	}
1.313     albertel 7345: 	$result.=<<ADDMETA
                   7346: <meta http-equiv="pragma" content="no-cache" />
1.344     albertel 7347: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313     albertel 7348: ADDMETA
                   7349:     }
1.306     albertel 7350:     if (!defined($title)) {
                   7351: 	$title = 'The LearningOnline Network with CAPA';
                   7352:     }
1.460     albertel 7353:     if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
                   7354:     $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61  raeburn  7355: 	.'<link rel="stylesheet" type="text/css" href="'.$url.'"';
                   7356:     if (!$args->{'frameset'}) {
                   7357:         $result .= ' /';
                   7358:     }
                   7359:     $result .= '>'
1.1064    raeburn  7360:         .$inhibitprint
1.414     albertel 7361: 	.$head_extra;
1.1075.2.42  raeburn  7362:     if ($env{'browser.mobile'}) {
                   7363:         $result .= '
                   7364: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
                   7365: <meta name="apple-mobile-web-app-capable" content="yes" />';
                   7366:     }
1.962     droeschl 7367:     return $result.'</head>';
1.306     albertel 7368: }
                   7369: 
                   7370: =pod
                   7371: 
1.340     albertel 7372: =item * &font_settings()
                   7373: 
                   7374: Returns neccessary <meta> to set the proper encoding
                   7375: 
1.1075.2.56  raeburn  7376: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340     albertel 7377: 
                   7378: =cut
                   7379: 
                   7380: sub font_settings {
1.1075.2.56  raeburn  7381:     my ($args) = @_;
1.340     albertel 7382:     my $headerstring='';
1.1075.2.56  raeburn  7383:     if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
                   7384:         ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340     albertel 7385: 	$headerstring.=
1.1075.2.61  raeburn  7386: 	    '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
                   7387:         if (!$args->{'frameset'}) {
                   7388:             $headerstring.= ' /';
                   7389:         }
                   7390:         $headerstring .= '>'."\n";
1.340     albertel 7391:     }
                   7392:     return $headerstring;
                   7393: }
                   7394: 
1.341     albertel 7395: =pod
                   7396: 
1.1064    raeburn  7397: =item * &print_suppression()
                   7398: 
                   7399: In course context returns css which causes the body to be blank when media="print",
                   7400: if printout generation is unavailable for the current resource.
                   7401: 
                   7402: This could be because:
                   7403: 
                   7404: (a) printstartdate is in the future
                   7405: 
                   7406: (b) printenddate is in the past
                   7407: 
                   7408: (c) there is an active exam block with "printout"
                   7409: functionality blocked
                   7410: 
                   7411: Users with pav, pfo or evb privileges are exempt.
                   7412: 
                   7413: Inputs: none
                   7414: 
                   7415: =cut
                   7416: 
                   7417: 
                   7418: sub print_suppression {
                   7419:     my $noprint;
                   7420:     if ($env{'request.course.id'}) {
                   7421:         my $scope = $env{'request.course.id'};
                   7422:         if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7423:             (&Apache::lonnet::allowed('pfo',$scope))) {
                   7424:             return;
                   7425:         }
                   7426:         if ($env{'request.course.sec'} ne '') {
                   7427:             $scope .= "/$env{'request.course.sec'}";
                   7428:             if ((&Apache::lonnet::allowed('pav',$scope)) ||
                   7429:                 (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065    raeburn  7430:                 return;
1.1064    raeburn  7431:             }
                   7432:         }
                   7433:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7434:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.73  raeburn  7435:         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064    raeburn  7436:         if ($blocked) {
                   7437:             my $checkrole = "cm./$cdom/$cnum";
                   7438:             if ($env{'request.course.sec'} ne '') {
                   7439:                 $checkrole .= "/$env{'request.course.sec'}";
                   7440:             }
                   7441:             unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
                   7442:                     ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
                   7443:                 $noprint = 1;
                   7444:             }
                   7445:         }
                   7446:         unless ($noprint) {
                   7447:             my $symb = &Apache::lonnet::symbread();
                   7448:             if ($symb ne '') {
                   7449:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   7450:                 if (ref($navmap)) {
                   7451:                     my $res = $navmap->getBySymb($symb);
                   7452:                     if (ref($res)) {
                   7453:                         if (!$res->resprintable()) {
                   7454:                             $noprint = 1;
                   7455:                         }
                   7456:                     }
                   7457:                 }
                   7458:             }
                   7459:         }
                   7460:         if ($noprint) {
                   7461:             return <<"ENDSTYLE";
                   7462: <style type="text/css" media="print">
                   7463:     body { display:none }
                   7464: </style>
                   7465: ENDSTYLE
                   7466:         }
                   7467:     }
                   7468:     return;
                   7469: }
                   7470: 
                   7471: =pod
                   7472: 
1.341     albertel 7473: =item * &xml_begin()
                   7474: 
                   7475: Returns the needed doctype and <html>
                   7476: 
                   7477: Inputs: none
                   7478: 
                   7479: =cut
                   7480: 
                   7481: sub xml_begin {
1.1075.2.61  raeburn  7482:     my ($is_frameset) = @_;
1.341     albertel 7483:     my $output='';
                   7484: 
                   7485:     if ($env{'browser.mathml'}) {
                   7486: 	$output='<?xml version="1.0"?>'
                   7487:             #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
                   7488: #            .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
                   7489:             
                   7490: #	    .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd" [<!ENTITY mathns "http://www.w3.org/1998/Math/MathML">] >'
                   7491: 	    .'<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0 plus SVG 1.1//EN" "http://www.w3.org/2002/04/xhtml-math-svg/xhtml-math-svg.dtd">'
                   7492:             .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" ' 
                   7493: 	    .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61  raeburn  7494:     } elsif ($is_frameset) {
                   7495:         $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
                   7496:                 '<html>'."\n";
1.341     albertel 7497:     } else {
1.1075.2.61  raeburn  7498: 	$output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
                   7499:                 '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341     albertel 7500:     }
                   7501:     return $output;
                   7502: }
1.340     albertel 7503: 
                   7504: =pod
                   7505: 
1.306     albertel 7506: =item * &start_page()
                   7507: 
                   7508: Returns a complete <html> .. <body> section for LON-CAPA web pages.
                   7509: 
1.648     raeburn  7510: Inputs:
                   7511: 
                   7512: =over 4
                   7513: 
                   7514: $title - optional title for the page
                   7515: 
                   7516: $head_extra - optional extra HTML to incude inside the <head>
                   7517: 
                   7518: $args - additional optional args supported are:
                   7519: 
                   7520: =over 8
                   7521: 
                   7522:              only_body      -> is true will set &bodytag() onlybodytag
1.317     albertel 7523:                                     arg on
1.814     bisitz   7524:              no_nav_bar     -> is true will set &bodytag() no_nav_bar arg on
1.648     raeburn  7525:              add_entries    -> additional attributes to add to the  <body>
                   7526:              domain         -> force to color decorate a page for a 
1.317     albertel 7527:                                     specific domain
1.648     raeburn  7528:              function       -> force usage of a specific rolish color
1.317     albertel 7529:                                     scheme
1.648     raeburn  7530:              redirect       -> see &headtag()
                   7531:              bgcolor        -> override the default page bg color
                   7532:              js_ready       -> return a string ready for being used in 
1.317     albertel 7533:                                     a javascript writeln
1.648     raeburn  7534:              html_encode    -> return a string ready for being used in 
1.320     albertel 7535:                                     a html attribute
1.648     raeburn  7536:              force_register -> if is true will turn on the &bodytag()
1.317     albertel 7537:                                     $forcereg arg
1.648     raeburn  7538:              frameset       -> if true will start with a <frameset>
1.330     albertel 7539:                                     rather than <body>
1.648     raeburn  7540:              skip_phases    -> hash ref of 
1.338     albertel 7541:                                     head -> skip the <html><head> generation
                   7542:                                     body -> skip all <body> generation
1.1075.2.12  raeburn  7543:              no_inline_link -> if true and in remote mode, don't show the
                   7544:                                     'Switch To Inline Menu' link
1.648     raeburn  7545:              no_auto_mt_title -> prevent &mt()ing the title arg
                   7546:              inherit_jsmath -> when creating popup window in a page,
                   7547:                                     should it have jsmath forced on by the
                   7548:                                     current page
1.867     kalberla 7549:              bread_crumbs ->             Array containing breadcrumbs
1.983     raeburn  7550:              bread_crumbs_component ->  if exists show it as headline else show only the breadcrumbs
1.1075.2.15  raeburn  7551:              group          -> includes the current group, if page is for a
                   7552:                                specific group
1.361     albertel 7553: 
1.648     raeburn  7554: =back
1.460     albertel 7555: 
1.648     raeburn  7556: =back
1.562     albertel 7557: 
1.306     albertel 7558: =cut
                   7559: 
                   7560: sub start_page {
1.309     albertel 7561:     my ($title,$head_extra,$args) = @_;
1.318     albertel 7562:     #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319     albertel 7563: 
1.315     albertel 7564:     $env{'internal.start_page'}++;
1.1075.2.15  raeburn  7565:     my ($result,@advtools);
1.964     droeschl 7566: 
1.338     albertel 7567:     if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62  raeburn  7568:         $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338     albertel 7569:     }
                   7570:     
                   7571:     if (! exists($args->{'skip_phases'}{'body'}) ) {
                   7572: 	if ($args->{'frameset'}) {
                   7573: 	    my $attr_string = &make_attr_string($args->{'force_register'},
                   7574: 						$args->{'add_entries'});
                   7575: 	    $result .= "\n<frameset $attr_string>\n";
1.831     bisitz   7576:         } else {
                   7577:             $result .=
                   7578:                 &bodytag($title, 
                   7579:                          $args->{'function'},       $args->{'add_entries'},
                   7580:                          $args->{'only_body'},      $args->{'domain'},
                   7581:                          $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12  raeburn  7582:                          $args->{'bgcolor'},        $args->{'no_inline_link'},
1.1075.2.15  raeburn  7583:                          $args,                     \@advtools);
1.831     bisitz   7584:         }
1.330     albertel 7585:     }
1.338     albertel 7586: 
1.315     albertel 7587:     if ($args->{'js_ready'}) {
1.713     kaisler  7588: 		$result = &js_ready($result);
1.315     albertel 7589:     }
1.320     albertel 7590:     if ($args->{'html_encode'}) {
1.713     kaisler  7591: 		$result = &html_encode($result);
                   7592:     }
                   7593: 
1.813     bisitz   7594:     # Preparation for new and consistent functionlist at top of screen
                   7595:     # if ($args->{'functionlist'}) {
                   7596:     #            $result .= &build_functionlist();
                   7597:     #}
                   7598: 
1.964     droeschl 7599:     # Don't add anything more if only_body wanted or in const space
                   7600:     return $result if    $args->{'only_body'} 
                   7601:                       || $env{'request.state'} eq 'construct';
1.813     bisitz   7602: 
                   7603:     #Breadcrumbs
1.758     kaisler  7604:     if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
                   7605: 		&Apache::lonhtmlcommon::clear_breadcrumbs();
                   7606: 		#if any br links exists, add them to the breadcrumbs
                   7607: 		if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {         
                   7608: 			foreach my $crumb (@{$args->{'bread_crumbs'}}){
                   7609: 				&Apache::lonhtmlcommon::add_breadcrumb($crumb);
                   7610: 			}
                   7611: 		}
1.1075.2.19  raeburn  7612:                 # if @advtools array contains items add then to the breadcrumbs
                   7613:                 if (@advtools > 0) {
                   7614:                     &Apache::lonmenu::advtools_crumbs(@advtools);
                   7615:                 }
1.758     kaisler  7616: 
                   7617: 		#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
                   7618: 		if(exists($args->{'bread_crumbs_component'})){
                   7619: 			$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
                   7620: 		}else{
                   7621: 			$result .= &Apache::lonhtmlcommon::breadcrumbs();
                   7622: 		}
1.1075.2.24  raeburn  7623:     } elsif (($env{'environment.remote'} eq 'on') &&
                   7624:              ($env{'form.inhibitmenu'} ne 'yes') &&
                   7625:              ($env{'request.noversionuri'} =~ m{^/res/}) &&
                   7626:              ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21  raeburn  7627:         $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320     albertel 7628:     }
1.315     albertel 7629:     return $result;
1.306     albertel 7630: }
                   7631: 
                   7632: sub end_page {
1.315     albertel 7633:     my ($args) = @_;
                   7634:     $env{'internal.end_page'}++;
1.330     albertel 7635:     my $result;
1.335     albertel 7636:     if ($args->{'discussion'}) {
                   7637: 	my ($target,$parser);
                   7638: 	if (ref($args->{'discussion'})) {
                   7639: 	    ($target,$parser) =($args->{'discussion'}{'target'},
                   7640: 				$args->{'discussion'}{'parser'});
                   7641: 	}
                   7642: 	$result .= &Apache::lonxml::xmlend($target,$parser);
                   7643:     }
1.330     albertel 7644:     if ($args->{'frameset'}) {
                   7645: 	$result .= '</frameset>';
                   7646:     } else {
1.635     raeburn  7647: 	$result .= &endbodytag($args);
1.330     albertel 7648:     }
1.1075.2.6  raeburn  7649:     unless ($args->{'notbody'}) {
                   7650:         $result .= "\n</html>";
                   7651:     }
1.330     albertel 7652: 
1.315     albertel 7653:     if ($args->{'js_ready'}) {
1.317     albertel 7654: 	$result = &js_ready($result);
1.315     albertel 7655:     }
1.335     albertel 7656: 
1.320     albertel 7657:     if ($args->{'html_encode'}) {
                   7658: 	$result = &html_encode($result);
                   7659:     }
1.335     albertel 7660: 
1.315     albertel 7661:     return $result;
                   7662: }
                   7663: 
1.1034    www      7664: sub wishlist_window {
                   7665:     return(<<'ENDWISHLIST');
1.1046    raeburn  7666: <script type="text/javascript">
1.1034    www      7667: // <![CDATA[
                   7668: // <!-- BEGIN LON-CAPA Internal
                   7669: function set_wishlistlink(title, path) {
                   7670:     if (!title) {
                   7671:         title = document.title;
                   7672:         title = title.replace(/^LON-CAPA /,'');
                   7673:     }
1.1075.2.65  raeburn  7674:     title = encodeURIComponent(title);
1.1075.2.83  raeburn  7675:     title = title.replace("'","\\\'");
1.1034    www      7676:     if (!path) {
                   7677:         path = location.pathname;
                   7678:     }
1.1075.2.65  raeburn  7679:     path = encodeURIComponent(path);
1.1075.2.83  raeburn  7680:     path = path.replace("'","\\\'");
1.1034    www      7681:     Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
                   7682:                       'wishlistNewLink','width=560,height=350,scrollbars=0');
                   7683: }
                   7684: // END LON-CAPA Internal -->
                   7685: // ]]>
                   7686: </script>
                   7687: ENDWISHLIST
                   7688: }
                   7689: 
1.1030    www      7690: sub modal_window {
                   7691:     return(<<'ENDMODAL');
1.1046    raeburn  7692: <script type="text/javascript">
1.1030    www      7693: // <![CDATA[
                   7694: // <!-- BEGIN LON-CAPA Internal
                   7695: var modalWindow = {
                   7696: 	parent:"body",
                   7697: 	windowId:null,
                   7698: 	content:null,
                   7699: 	width:null,
                   7700: 	height:null,
                   7701: 	close:function()
                   7702: 	{
                   7703: 	        $(".LCmodal-window").remove();
                   7704: 	        $(".LCmodal-overlay").remove();
                   7705: 	},
                   7706: 	open:function()
                   7707: 	{
                   7708: 		var modal = "";
                   7709: 		modal += "<div class=\"LCmodal-overlay\"></div>";
                   7710: 		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;\">";
                   7711: 		modal += this.content;
                   7712: 		modal += "</div>";	
                   7713: 
                   7714: 		$(this.parent).append(modal);
                   7715: 
                   7716: 		$(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
                   7717: 		$(".LCclose-window").click(function(){modalWindow.close();});
                   7718: 		$(".LCmodal-overlay").click(function(){modalWindow.close();});
                   7719: 	}
                   7720: };
1.1075.2.42  raeburn  7721: 	var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030    www      7722: 	{
1.1075.2.83  raeburn  7723:                 source = source.replace("'","&#39;");
1.1030    www      7724: 		modalWindow.windowId = "myModal";
                   7725: 		modalWindow.width = width;
                   7726: 		modalWindow.height = height;
1.1075.2.80  raeburn  7727: 		modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030    www      7728: 		modalWindow.open();
                   7729: 	};	
                   7730: // END LON-CAPA Internal -->
                   7731: // ]]>
                   7732: </script>
                   7733: ENDMODAL
                   7734: }
                   7735: 
                   7736: sub modal_link {
1.1075.2.42  raeburn  7737:     my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030    www      7738:     unless ($width) { $width=480; }
                   7739:     unless ($height) { $height=400; }
1.1031    www      7740:     unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42  raeburn  7741:     unless ($transparency) { $transparency='true'; }
                   7742: 
1.1074    raeburn  7743:     my $target_attr;
                   7744:     if (defined($target)) {
                   7745:         $target_attr = 'target="'.$target.'"';
                   7746:     }
                   7747:     return <<"ENDLINK";
1.1075.2.42  raeburn  7748: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074    raeburn  7749:            $linktext</a>
                   7750: ENDLINK
1.1030    www      7751: }
                   7752: 
1.1032    www      7753: sub modal_adhoc_script {
                   7754:     my ($funcname,$width,$height,$content)=@_;
                   7755:     return (<<ENDADHOC);
1.1046    raeburn  7756: <script type="text/javascript">
1.1032    www      7757: // <![CDATA[
                   7758:         var $funcname = function()
                   7759:         {
                   7760:                 modalWindow.windowId = "myModal";
                   7761:                 modalWindow.width = $width;
                   7762:                 modalWindow.height = $height;
                   7763:                 modalWindow.content = '$content';
                   7764:                 modalWindow.open();
                   7765:         };  
                   7766: // ]]>
                   7767: </script>
                   7768: ENDADHOC
                   7769: }
                   7770: 
1.1041    www      7771: sub modal_adhoc_inner {
                   7772:     my ($funcname,$width,$height,$content)=@_;
                   7773:     my $innerwidth=$width-20;
                   7774:     $content=&js_ready(
1.1042    www      7775:                &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42  raeburn  7776:                  &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
                   7777:                  $content.
1.1041    www      7778:                  &end_scrollbox().
1.1075.2.42  raeburn  7779:                  &end_page()
1.1041    www      7780:              );
                   7781:     return &modal_adhoc_script($funcname,$width,$height,$content);
                   7782: }
                   7783: 
                   7784: sub modal_adhoc_window {
                   7785:     my ($funcname,$width,$height,$content,$linktext)=@_;
                   7786:     return &modal_adhoc_inner($funcname,$width,$height,$content).
                   7787:            "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
                   7788: }
                   7789: 
                   7790: sub modal_adhoc_launch {
                   7791:     my ($funcname,$width,$height,$content)=@_;
                   7792:     return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
                   7793: <script type="text/javascript">
                   7794: // <![CDATA[
                   7795: $funcname();
                   7796: // ]]>
                   7797: </script>
                   7798: ENDLAUNCH
                   7799: }
                   7800: 
                   7801: sub modal_adhoc_close {
                   7802:     return (<<ENDCLOSE);
                   7803: <script type="text/javascript">
                   7804: // <![CDATA[
                   7805: modalWindow.close();
                   7806: // ]]>
                   7807: </script>
                   7808: ENDCLOSE
                   7809: }
                   7810: 
1.1038    www      7811: sub togglebox_script {
                   7812:    return(<<ENDTOGGLE);
                   7813: <script type="text/javascript"> 
                   7814: // <![CDATA[
                   7815: function LCtoggleDisplay(id,hidetext,showtext) {
                   7816:    link = document.getElementById(id + "link").childNodes[0];
                   7817:    with (document.getElementById(id).style) {
                   7818:       if (display == "none" ) {
                   7819:           display = "inline";
                   7820:           link.nodeValue = hidetext;
                   7821:         } else {
                   7822:           display = "none";
                   7823:           link.nodeValue = showtext;
                   7824:        }
                   7825:    }
                   7826: }
                   7827: // ]]>
                   7828: </script>
                   7829: ENDTOGGLE
                   7830: }
                   7831: 
1.1039    www      7832: sub start_togglebox {
                   7833:     my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
                   7834:     unless ($heading) { $heading=''; } else { $heading.=' '; }
                   7835:     unless ($showtext) { $showtext=&mt('show'); }
                   7836:     unless ($hidetext) { $hidetext=&mt('hide'); }
                   7837:     unless ($headerbg) { $headerbg='#FFFFFF'; }
                   7838:     return &start_data_table().
                   7839:            &start_data_table_header_row().
                   7840:            '<td bgcolor="'.$headerbg.'">'.$heading.
                   7841:            '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
                   7842:            $showtext.'\')">'.$showtext.'</a>]</td>'.
                   7843:            &end_data_table_header_row().
                   7844:            '<tr id="'.$id.'" style="display:none""><td>';
                   7845: }
                   7846: 
                   7847: sub end_togglebox {
                   7848:     return '</td></tr>'.&end_data_table();
                   7849: }
                   7850: 
1.1041    www      7851: sub LCprogressbar_script {
1.1045    www      7852:    my ($id)=@_;
1.1041    www      7853:    return(<<ENDPROGRESS);
                   7854: <script type="text/javascript">
                   7855: // <![CDATA[
1.1045    www      7856: \$('#progressbar$id').progressbar({
1.1041    www      7857:   value: 0,
                   7858:   change: function(event, ui) {
                   7859:     var newVal = \$(this).progressbar('option', 'value');
                   7860:     \$('.pblabel', this).text(LCprogressTxt);
                   7861:   }
                   7862: });
                   7863: // ]]>
                   7864: </script>
                   7865: ENDPROGRESS
                   7866: }
                   7867: 
                   7868: sub LCprogressbarUpdate_script {
                   7869:    return(<<ENDPROGRESSUPDATE);
                   7870: <style type="text/css">
                   7871: .ui-progressbar { position:relative; }
                   7872: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
                   7873: </style>
                   7874: <script type="text/javascript">
                   7875: // <![CDATA[
1.1045    www      7876: var LCprogressTxt='---';
                   7877: 
                   7878: function LCupdateProgress(percent,progresstext,id) {
1.1041    www      7879:    LCprogressTxt=progresstext;
1.1045    www      7880:    \$('#progressbar'+id).progressbar('value',percent);
1.1041    www      7881: }
                   7882: // ]]>
                   7883: </script>
                   7884: ENDPROGRESSUPDATE
                   7885: }
                   7886: 
1.1042    www      7887: my $LClastpercent;
1.1045    www      7888: my $LCidcnt;
                   7889: my $LCcurrentid;
1.1042    www      7890: 
1.1041    www      7891: sub LCprogressbar {
1.1042    www      7892:     my ($r)=(@_);
                   7893:     $LClastpercent=0;
1.1045    www      7894:     $LCidcnt++;
                   7895:     $LCcurrentid=$$.'_'.$LCidcnt;
1.1041    www      7896:     my $starting=&mt('Starting');
                   7897:     my $content=(<<ENDPROGBAR);
1.1045    www      7898:   <div id="progressbar$LCcurrentid">
1.1041    www      7899:     <span class="pblabel">$starting</span>
                   7900:   </div>
                   7901: ENDPROGBAR
1.1045    www      7902:     &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041    www      7903: }
                   7904: 
                   7905: sub LCprogressbarUpdate {
1.1042    www      7906:     my ($r,$val,$text)=@_;
                   7907:     unless ($val) { 
                   7908:        if ($LClastpercent) {
                   7909:            $val=$LClastpercent;
                   7910:        } else {
                   7911:            $val=0;
                   7912:        }
                   7913:     }
1.1041    www      7914:     if ($val<0) { $val=0; }
                   7915:     if ($val>100) { $val=0; }
1.1042    www      7916:     $LClastpercent=$val;
1.1041    www      7917:     unless ($text) { $text=$val.'%'; }
                   7918:     $text=&js_ready($text);
1.1044    www      7919:     &r_print($r,<<ENDUPDATE);
1.1041    www      7920: <script type="text/javascript">
                   7921: // <![CDATA[
1.1045    www      7922: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041    www      7923: // ]]>
                   7924: </script>
                   7925: ENDUPDATE
1.1035    www      7926: }
                   7927: 
1.1042    www      7928: sub LCprogressbarClose {
                   7929:     my ($r)=@_;
                   7930:     $LClastpercent=0;
1.1044    www      7931:     &r_print($r,<<ENDCLOSE);
1.1042    www      7932: <script type="text/javascript">
                   7933: // <![CDATA[
1.1045    www      7934: \$("#progressbar$LCcurrentid").hide('slow'); 
1.1042    www      7935: // ]]>
                   7936: </script>
                   7937: ENDCLOSE
1.1044    www      7938: }
                   7939: 
                   7940: sub r_print {
                   7941:     my ($r,$to_print)=@_;
                   7942:     if ($r) {
                   7943:       $r->print($to_print);
                   7944:       $r->rflush();
                   7945:     } else {
                   7946:       print($to_print);
                   7947:     }
1.1042    www      7948: }
                   7949: 
1.320     albertel 7950: sub html_encode {
                   7951:     my ($result) = @_;
                   7952: 
1.322     albertel 7953:     $result = &HTML::Entities::encode($result,'<>&"');
1.320     albertel 7954:     
                   7955:     return $result;
                   7956: }
1.1044    www      7957: 
1.317     albertel 7958: sub js_ready {
                   7959:     my ($result) = @_;
                   7960: 
1.323     albertel 7961:     $result =~ s/[\n\r]/ /xmsg;
                   7962:     $result =~ s/\\/\\\\/xmsg;
                   7963:     $result =~ s/'/\\'/xmsg;
1.372     albertel 7964:     $result =~ s{</}{<\\/}xmsg;
1.317     albertel 7965:     
                   7966:     return $result;
                   7967: }
                   7968: 
1.315     albertel 7969: sub validate_page {
                   7970:     if (  exists($env{'internal.start_page'})
1.316     albertel 7971: 	  &&     $env{'internal.start_page'} > 1) {
                   7972: 	&Apache::lonnet::logthis('start_page called multiple times '.
1.318     albertel 7973: 				 $env{'internal.start_page'}.' '.
1.316     albertel 7974: 				 $ENV{'request.filename'});
1.315     albertel 7975:     }
                   7976:     if (  exists($env{'internal.end_page'})
1.316     albertel 7977: 	  &&     $env{'internal.end_page'} > 1) {
                   7978: 	&Apache::lonnet::logthis('end_page called multiple times '.
1.318     albertel 7979: 				 $env{'internal.end_page'}.' '.
1.316     albertel 7980: 				 $env{'request.filename'});
1.315     albertel 7981:     }
                   7982:     if (     exists($env{'internal.start_page'})
                   7983: 	&& ! exists($env{'internal.end_page'})) {
1.316     albertel 7984: 	&Apache::lonnet::logthis('start_page called without end_page '.
                   7985: 				 $env{'request.filename'});
1.315     albertel 7986:     }
                   7987:     if (   ! exists($env{'internal.start_page'})
                   7988: 	&&   exists($env{'internal.end_page'})) {
1.316     albertel 7989: 	&Apache::lonnet::logthis('end_page called without start_page'.
                   7990: 				 $env{'request.filename'});
1.315     albertel 7991:     }
1.306     albertel 7992: }
1.315     albertel 7993: 
1.996     www      7994: 
                   7995: sub start_scrollbox {
1.1075.2.56  raeburn  7996:     my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998     raeburn  7997:     unless ($outerwidth) { $outerwidth='520px'; }
                   7998:     unless ($width) { $width='500px'; }
                   7999:     unless ($height) { $height='200px'; }
1.1075    raeburn  8000:     my ($table_id,$div_id,$tdcol);
1.1018    raeburn  8001:     if ($id ne '') {
1.1075.2.42  raeburn  8002:         $table_id = ' id="table_'.$id.'"';
                   8003:         $div_id = ' id="div_'.$id.'"';
1.1018    raeburn  8004:     }
1.1075    raeburn  8005:     if ($bgcolor ne '') {
                   8006:         $tdcol = "background-color: $bgcolor;";
                   8007:     }
1.1075.2.42  raeburn  8008:     my $nicescroll_js;
                   8009:     if ($env{'browser.mobile'}) {
                   8010:         $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
                   8011:     }
1.1075    raeburn  8012:     return <<"END";
1.1075.2.42  raeburn  8013: $nicescroll_js
                   8014: 
                   8015: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56  raeburn  8016: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075    raeburn  8017: END
1.996     www      8018: }
                   8019: 
                   8020: sub end_scrollbox {
1.1036    www      8021:     return '</div></td></tr></table>';
1.996     www      8022: }
                   8023: 
1.1075.2.42  raeburn  8024: sub nicescroll_javascript {
                   8025:     my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
                   8026:     my %options;
                   8027:     if (ref($cursor) eq 'HASH') {
                   8028:         %options = %{$cursor};
                   8029:     }
                   8030:     unless ($options{'railalign'} =~ /^left|right$/) {
                   8031:         $options{'railalign'} = 'left';
                   8032:     }
                   8033:     unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8034:         my $function  = &get_users_function();
                   8035:         $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
                   8036:         unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
                   8037:             $options{'cursorcolor'} = '#00F';
                   8038:         }
                   8039:     }
                   8040:     if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
                   8041:         unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
                   8042:             $options{'cursoropacity'}='1.0';
                   8043:         }
                   8044:     } else {
                   8045:         $options{'cursoropacity'}='1.0';
                   8046:     }
                   8047:     if ($options{'cursorfixedheight'} eq 'none') {
                   8048:         delete($options{'cursorfixedheight'});
                   8049:     } else {
                   8050:         unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
                   8051:     }
                   8052:     unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
                   8053:         delete($options{'railoffset'});
                   8054:     }
                   8055:     my @niceoptions;
                   8056:     while (my($key,$value) = each(%options)) {
                   8057:         if ($value =~ /^\{.+\}$/) {
                   8058:             push(@niceoptions,$key.':'.$value);
                   8059:         } else {
                   8060:             push(@niceoptions,$key.':"'.$value.'"');
                   8061:         }
                   8062:     }
                   8063:     my $nicescroll_js = '
                   8064: $(document).ready(
                   8065:       function() {
                   8066:           $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
                   8067:       }
                   8068: );
                   8069: ';
                   8070:     if ($framecheck) {
                   8071:         $nicescroll_js .= '
                   8072: function expand_div(caller) {
                   8073:     if (top === self) {
                   8074:         document.getElementById("'.$id.'").style.width = "auto";
                   8075:         document.getElementById("'.$id.'").style.height = "auto";
                   8076:     } else {
                   8077:         try {
                   8078:             if (parent.frames) {
                   8079:                 if (parent.frames.length > 1) {
                   8080:                     var framesrc = parent.frames[1].location.href;
                   8081:                     var currsrc = framesrc.replace(/\#.*$/,"");
                   8082:                     if ((caller == "search") || (currsrc == "'.$location.'")) {
                   8083:                         document.getElementById("'.$id.'").style.width = "auto";
                   8084:                         document.getElementById("'.$id.'").style.height = "auto";
                   8085:                     }
                   8086:                 }
                   8087:             }
                   8088:         } catch (e) {
                   8089:             return;
                   8090:         }
                   8091:     }
                   8092:     return;
                   8093: }
                   8094: ';
                   8095:     }
                   8096:     if ($needjsready) {
                   8097:         $nicescroll_js = '
                   8098: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
                   8099:     } else {
                   8100:         $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
                   8101:     }
                   8102:     return $nicescroll_js;
                   8103: }
                   8104: 
1.318     albertel 8105: sub simple_error_page {
1.1075.2.49  raeburn  8106:     my ($r,$title,$msg,$args) = @_;
                   8107:     if (ref($args) eq 'HASH') {
                   8108:         if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
                   8109:     } else {
                   8110:         $msg = &mt($msg);
                   8111:     }
                   8112: 
1.318     albertel 8113:     my $page =
                   8114: 	&Apache::loncommon::start_page($title).
1.1075.2.49  raeburn  8115: 	'<p class="LC_error">'.$msg.'</p>'.
1.318     albertel 8116: 	&Apache::loncommon::end_page();
                   8117:     if (ref($r)) {
                   8118: 	$r->print($page);
1.327     albertel 8119: 	return;
1.318     albertel 8120:     }
                   8121:     return $page;
                   8122: }
1.347     albertel 8123: 
                   8124: {
1.610     albertel 8125:     my @row_count;
1.961     onken    8126: 
                   8127:     sub start_data_table_count {
                   8128:         unshift(@row_count, 0);
                   8129:         return;
                   8130:     }
                   8131: 
                   8132:     sub end_data_table_count {
                   8133:         shift(@row_count);
                   8134:         return;
                   8135:     }
                   8136: 
1.347     albertel 8137:     sub start_data_table {
1.1018    raeburn  8138: 	my ($add_class,$id) = @_;
1.422     albertel 8139: 	my $css_class = (join(' ','LC_data_table',$add_class));
1.1018    raeburn  8140:         my $table_id;
                   8141:         if (defined($id)) {
                   8142:             $table_id = ' id="'.$id.'"';
                   8143:         }
1.961     onken    8144: 	&start_data_table_count();
1.1018    raeburn  8145: 	return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347     albertel 8146:     }
                   8147: 
                   8148:     sub end_data_table {
1.961     onken    8149: 	&end_data_table_count();
1.389     albertel 8150: 	return '</table>'."\n";;
1.347     albertel 8151:     }
                   8152: 
                   8153:     sub start_data_table_row {
1.974     wenzelju 8154: 	my ($add_class, $id) = @_;
1.610     albertel 8155: 	$row_count[0]++;
                   8156: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900     bisitz   8157: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974     wenzelju 8158:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8159:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347     albertel 8160:     }
1.471     banghart 8161:     
                   8162:     sub continue_data_table_row {
1.974     wenzelju 8163: 	my ($add_class, $id) = @_;
1.610     albertel 8164: 	my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974     wenzelju 8165: 	$css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
                   8166:         $id = (' id="'.$id.'"') unless ($id eq '');
                   8167:         return  '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471     banghart 8168:     }
1.347     albertel 8169: 
                   8170:     sub end_data_table_row {
1.389     albertel 8171: 	return '</tr>'."\n";;
1.347     albertel 8172:     }
1.367     www      8173: 
1.421     albertel 8174:     sub start_data_table_empty_row {
1.707     bisitz   8175: #	$row_count[0]++;
1.421     albertel 8176: 	return  '<tr class="LC_empty_row" >'."\n";;
                   8177:     }
                   8178: 
                   8179:     sub end_data_table_empty_row {
                   8180: 	return '</tr>'."\n";;
                   8181:     }
                   8182: 
1.367     www      8183:     sub start_data_table_header_row {
1.389     albertel 8184: 	return  '<tr class="LC_header_row">'."\n";;
1.367     www      8185:     }
                   8186: 
                   8187:     sub end_data_table_header_row {
1.389     albertel 8188: 	return '</tr>'."\n";;
1.367     www      8189:     }
1.890     droeschl 8190: 
                   8191:     sub data_table_caption {
                   8192:         my $caption = shift;
                   8193:         return "<caption class=\"LC_caption\">$caption</caption>";
                   8194:     }
1.347     albertel 8195: }
                   8196: 
1.548     albertel 8197: =pod
                   8198: 
                   8199: =item * &inhibit_menu_check($arg)
                   8200: 
                   8201: Checks for a inhibitmenu state and generates output to preserve it
                   8202: 
                   8203: Inputs:         $arg - can be any of
                   8204:                      - undef - in which case the return value is a string 
                   8205:                                to add  into arguments list of a uri
                   8206:                      - 'input' - in which case the return value is a HTML
                   8207:                                  <form> <input> field of type hidden to
                   8208:                                  preserve the value
                   8209:                      - a url - in which case the return value is the url with
                   8210:                                the neccesary cgi args added to preserve the
                   8211:                                inhibitmenu state
                   8212:                      - a ref to a url - no return value, but the string is
                   8213:                                         updated to include the neccessary cgi
                   8214:                                         args to preserve the inhibitmenu state
                   8215: 
                   8216: =cut
                   8217: 
                   8218: sub inhibit_menu_check {
                   8219:     my ($arg) = @_;
                   8220:     &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
                   8221:     if ($arg eq 'input') {
                   8222: 	if ($env{'form.inhibitmenu'}) {
                   8223: 	    return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
                   8224: 	} else {
                   8225: 	    return
                   8226: 	}
                   8227:     }
                   8228:     if ($env{'form.inhibitmenu'}) {
                   8229: 	if (ref($arg)) {
                   8230: 	    $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8231: 	} elsif ($arg eq '') {
                   8232: 	    $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
                   8233: 	} else {
                   8234: 	    $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
                   8235: 	}
                   8236:     }
                   8237:     if (!ref($arg)) {
                   8238: 	return $arg;
                   8239:     }
                   8240: }
                   8241: 
1.251     albertel 8242: ###############################################
1.182     matthew  8243: 
                   8244: =pod
                   8245: 
1.549     albertel 8246: =back
                   8247: 
                   8248: =head1 User Information Routines
                   8249: 
                   8250: =over 4
                   8251: 
1.405     albertel 8252: =item * &get_users_function()
1.182     matthew  8253: 
                   8254: Used by &bodytag to determine the current users primary role.
                   8255: Returns either 'student','coordinator','admin', or 'author'.
                   8256: 
                   8257: =cut
                   8258: 
                   8259: ###############################################
                   8260: sub get_users_function {
1.815     tempelho 8261:     my $function = 'norole';
1.818     tempelho 8262:     if ($env{'request.role'}=~/^(st)/) {
                   8263:         $function='student';
                   8264:     }
1.907     raeburn  8265:     if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182     matthew  8266:         $function='coordinator';
                   8267:     }
1.258     albertel 8268:     if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182     matthew  8269:         $function='admin';
                   8270:     }
1.826     bisitz   8271:     if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025    raeburn  8272:         ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182     matthew  8273:         $function='author';
                   8274:     }
                   8275:     return $function;
1.54      www      8276: }
1.99      www      8277: 
                   8278: ###############################################
                   8279: 
1.233     raeburn  8280: =pod
                   8281: 
1.821     raeburn  8282: =item * &show_course()
                   8283: 
                   8284: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
                   8285: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
                   8286: 
                   8287: Inputs:
                   8288: None
                   8289: 
                   8290: Outputs:
                   8291: Scalar: 1 if 'Course' to be used, 0 otherwise.
                   8292: 
                   8293: =cut
                   8294: 
                   8295: ###############################################
                   8296: sub show_course {
                   8297:     my $course = !$env{'user.adv'};
                   8298:     if (!$env{'user.adv'}) {
                   8299:         foreach my $env (keys(%env)) {
                   8300:             next if ($env !~ m/^user\.priv\./);
                   8301:             if ($env !~ m/^user\.priv\.(?:st|cm)/) {
                   8302:                 $course = 0;
                   8303:                 last;
                   8304:             }
                   8305:         }
                   8306:     }
                   8307:     return $course;
                   8308: }
                   8309: 
                   8310: ###############################################
                   8311: 
                   8312: =pod
                   8313: 
1.542     raeburn  8314: =item * &check_user_status()
1.274     raeburn  8315: 
                   8316: Determines current status of supplied role for a
                   8317: specific user. Roles can be active, previous or future.
                   8318: 
                   8319: Inputs: 
                   8320: user's domain, user's username, course's domain,
1.375     raeburn  8321: course's number, optional section ID.
1.274     raeburn  8322: 
                   8323: Outputs:
                   8324: role status: active, previous or future. 
                   8325: 
                   8326: =cut
                   8327: 
                   8328: sub check_user_status {
1.412     raeburn  8329:     my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073    raeburn  8330:     my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274     raeburn  8331:     my @uroles = keys %userinfo;
                   8332:     my $srchstr;
                   8333:     my $active_chk = 'none';
1.412     raeburn  8334:     my $now = time;
1.274     raeburn  8335:     if (@uroles > 0) {
1.908     raeburn  8336:         if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274     raeburn  8337:             $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
                   8338:         } else {
1.412     raeburn  8339:             $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
                   8340:         }
                   8341:         if (grep/^\Q$srchstr\E$/,@uroles) {
1.274     raeburn  8342:             my $role_end = 0;
                   8343:             my $role_start = 0;
                   8344:             $active_chk = 'active';
1.412     raeburn  8345:             if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
                   8346:                 $role_end = $1;
                   8347:                 if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
                   8348:                     $role_start = $1;
1.274     raeburn  8349:                 }
                   8350:             }
                   8351:             if ($role_start > 0) {
1.412     raeburn  8352:                 if ($now < $role_start) {
1.274     raeburn  8353:                     $active_chk = 'future';
                   8354:                 }
                   8355:             }
                   8356:             if ($role_end > 0) {
1.412     raeburn  8357:                 if ($now > $role_end) {
1.274     raeburn  8358:                     $active_chk = 'previous';
                   8359:                 }
                   8360:             }
                   8361:         }
                   8362:     }
                   8363:     return $active_chk;
                   8364: }
                   8365: 
                   8366: ###############################################
                   8367: 
                   8368: =pod
                   8369: 
1.405     albertel 8370: =item * &get_sections()
1.233     raeburn  8371: 
                   8372: Determines all the sections for a course including
                   8373: sections with students and sections containing other roles.
1.419     raeburn  8374: Incoming parameters: 
                   8375: 
                   8376: 1. domain
                   8377: 2. course number 
                   8378: 3. reference to array containing roles for which sections should 
                   8379: be gathered (optional).
                   8380: 4. reference to array containing status types for which sections 
                   8381: should be gathered (optional).
                   8382: 
                   8383: If the third argument is undefined, sections are gathered for any role. 
                   8384: If the fourth argument is undefined, sections are gathered for any status.
                   8385: Permissible values are 'active' or 'future' or 'previous'.
1.233     raeburn  8386:  
1.374     raeburn  8387: Returns section hash (keys are section IDs, values are
                   8388: number of users in each section), subject to the
1.419     raeburn  8389: optional roles filter, optional status filter 
1.233     raeburn  8390: 
                   8391: =cut
                   8392: 
                   8393: ###############################################
                   8394: sub get_sections {
1.419     raeburn  8395:     my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366     albertel 8396:     if (!defined($cdom) || !defined($cnum)) {
                   8397:         my $cid =  $env{'request.course.id'};
                   8398: 
                   8399: 	return if (!defined($cid));
                   8400: 
                   8401:         $cdom = $env{'course.'.$cid.'.domain'};
                   8402:         $cnum = $env{'course.'.$cid.'.num'};
                   8403:     }
                   8404: 
                   8405:     my %sectioncount;
1.419     raeburn  8406:     my $now = time;
1.240     albertel 8407: 
1.1075.2.33  raeburn  8408:     my $check_students = 1;
                   8409:     my $only_students = 0;
                   8410:     if (ref($possible_roles) eq 'ARRAY') {
                   8411:         if (grep(/^st$/,@{$possible_roles})) {
                   8412:             if (@{$possible_roles} == 1) {
                   8413:                 $only_students = 1;
                   8414:             }
                   8415:         } else {
                   8416:             $check_students = 0;
                   8417:         }
                   8418:     }
                   8419: 
                   8420:     if ($check_students) {
1.276     albertel 8421: 	my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240     albertel 8422: 	my $sec_index = &Apache::loncoursedata::CL_SECTION();
                   8423: 	my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419     raeburn  8424:         my $start_index = &Apache::loncoursedata::CL_START();
                   8425:         my $end_index = &Apache::loncoursedata::CL_END();
                   8426:         my $status;
1.366     albertel 8427: 	while (my ($student,$data) = each(%$classlist)) {
1.419     raeburn  8428: 	    my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
                   8429: 				                     $data->[$status_index],
                   8430:                                                      $data->[$start_index],
                   8431:                                                      $data->[$end_index]);
                   8432:             if ($stu_status eq 'Active') {
                   8433:                 $status = 'active';
                   8434:             } elsif ($end < $now) {
                   8435:                 $status = 'previous';
                   8436:             } elsif ($start > $now) {
                   8437:                 $status = 'future';
                   8438:             } 
                   8439: 	    if ($section ne '-1' && $section !~ /^\s*$/) {
                   8440:                 if ((!defined($possible_status)) || (($status ne '') && 
                   8441:                     (grep/^\Q$status\E$/,@{$possible_status}))) { 
                   8442: 		    $sectioncount{$section}++;
                   8443:                 }
1.240     albertel 8444: 	    }
                   8445: 	}
                   8446:     }
1.1075.2.33  raeburn  8447:     if ($only_students) {
                   8448:         return %sectioncount;
                   8449:     }
1.240     albertel 8450:     my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8451:     foreach my $user (sort(keys(%courseroles))) {
                   8452: 	if ($user !~ /^(\w{2})/) { next; }
                   8453: 	my ($role) = ($user =~ /^(\w{2})/);
                   8454: 	if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419     raeburn  8455: 	my ($section,$status);
1.240     albertel 8456: 	if ($role eq 'cr' &&
                   8457: 	    $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
                   8458: 	    $section=$1;
                   8459: 	}
                   8460: 	if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
                   8461: 	if (!defined($section) || $section eq '-1') { next; }
1.419     raeburn  8462:         my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
                   8463:         if ($end == -1 && $start == -1) {
                   8464:             next; #deleted role
                   8465:         }
                   8466:         if (!defined($possible_status)) { 
                   8467:             $sectioncount{$section}++;
                   8468:         } else {
                   8469:             if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
                   8470:                 $status = 'active';
                   8471:             } elsif ($end < $now) {
                   8472:                 $status = 'future';
                   8473:             } elsif ($start > $now) {
                   8474:                 $status = 'previous';
                   8475:             }
                   8476:             if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
                   8477:                 $sectioncount{$section}++;
                   8478:             }
                   8479:         }
1.233     raeburn  8480:     }
1.366     albertel 8481:     return %sectioncount;
1.233     raeburn  8482: }
                   8483: 
1.274     raeburn  8484: ###############################################
1.294     raeburn  8485: 
                   8486: =pod
1.405     albertel 8487: 
                   8488: =item * &get_course_users()
                   8489: 
1.275     raeburn  8490: Retrieves usernames:domains for users in the specified course
                   8491: with specific role(s), and access status. 
                   8492: 
                   8493: Incoming parameters:
1.277     albertel 8494: 1. course domain
                   8495: 2. course number
                   8496: 3. access status: users must have - either active, 
1.275     raeburn  8497: previous, future, or all.
1.277     albertel 8498: 4. reference to array of permissible roles
1.288     raeburn  8499: 5. reference to array of section restrictions (optional)
                   8500: 6. reference to results object (hash of hashes).
                   8501: 7. reference to optional userdata hash
1.609     raeburn  8502: 8. reference to optional statushash
1.630     raeburn  8503: 9. flag if privileged users (except those set to unhide in
                   8504:    course settings) should be excluded    
1.609     raeburn  8505: Keys of top level results hash are roles.
1.275     raeburn  8506: Keys of inner hashes are username:domain, with 
                   8507: values set to access type.
1.288     raeburn  8508: Optional userdata hash returns an array with arguments in the 
                   8509: same order as loncoursedata::get_classlist() for student data.
                   8510: 
1.609     raeburn  8511: Optional statushash returns
                   8512: 
1.288     raeburn  8513: Entries for end, start, section and status are blank because
                   8514: of the possibility of multiple values for non-student roles.
                   8515: 
1.275     raeburn  8516: =cut
1.405     albertel 8517: 
1.275     raeburn  8518: ###############################################
1.405     albertel 8519: 
1.275     raeburn  8520: sub get_course_users {
1.630     raeburn  8521:     my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288     raeburn  8522:     my %idx = ();
1.419     raeburn  8523:     my %seclists;
1.288     raeburn  8524: 
                   8525:     $idx{udom} = &Apache::loncoursedata::CL_SDOM();
                   8526:     $idx{uname} =  &Apache::loncoursedata::CL_SNAME();
                   8527:     $idx{end} = &Apache::loncoursedata::CL_END();
                   8528:     $idx{start} = &Apache::loncoursedata::CL_START();
                   8529:     $idx{id} = &Apache::loncoursedata::CL_ID();
                   8530:     $idx{section} = &Apache::loncoursedata::CL_SECTION();
                   8531:     $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
                   8532:     $idx{status} = &Apache::loncoursedata::CL_STATUS();
                   8533: 
1.290     albertel 8534:     if (grep(/^st$/,@{$roles})) {
1.276     albertel 8535:         my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278     raeburn  8536:         my $now = time;
1.277     albertel 8537:         foreach my $student (keys(%{$classlist})) {
1.288     raeburn  8538:             my $match = 0;
1.412     raeburn  8539:             my $secmatch = 0;
1.419     raeburn  8540:             my $section = $$classlist{$student}[$idx{section}];
1.609     raeburn  8541:             my $status = $$classlist{$student}[$idx{status}];
1.419     raeburn  8542:             if ($section eq '') {
                   8543:                 $section = 'none';
                   8544:             }
1.291     albertel 8545:             if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8546:                 if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8547:                     $secmatch = 1;
                   8548:                 } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420     albertel 8549:                     if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8550:                         $secmatch = 1;
                   8551:                     }
                   8552:                 } else {  
1.419     raeburn  8553: 		    if (grep(/^\Q$section\E$/,@{$sections})) {
1.412     raeburn  8554: 		        $secmatch = 1;
                   8555:                     }
1.290     albertel 8556: 		}
1.412     raeburn  8557:                 if (!$secmatch) {
                   8558:                     next;
                   8559:                 }
1.419     raeburn  8560:             }
1.275     raeburn  8561:             if (defined($$types{'active'})) {
1.288     raeburn  8562:                 if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275     raeburn  8563:                     push(@{$$users{st}{$student}},'active');
1.288     raeburn  8564:                     $match = 1;
1.275     raeburn  8565:                 }
                   8566:             }
                   8567:             if (defined($$types{'previous'})) {
1.609     raeburn  8568:                 if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275     raeburn  8569:                     push(@{$$users{st}{$student}},'previous');
1.288     raeburn  8570:                     $match = 1;
1.275     raeburn  8571:                 }
                   8572:             }
                   8573:             if (defined($$types{'future'})) {
1.609     raeburn  8574:                 if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275     raeburn  8575:                     push(@{$$users{st}{$student}},'future');
1.288     raeburn  8576:                     $match = 1;
1.275     raeburn  8577:                 }
                   8578:             }
1.609     raeburn  8579:             if ($match) {
                   8580:                 push(@{$seclists{$student}},$section);
                   8581:                 if (ref($userdata) eq 'HASH') {
                   8582:                     $$userdata{$student} = $$classlist{$student};
                   8583:                 }
                   8584:                 if (ref($statushash) eq 'HASH') {
                   8585:                     $statushash->{$student}{'st'}{$section} = $status;
                   8586:                 }
1.288     raeburn  8587:             }
1.275     raeburn  8588:         }
                   8589:     }
1.412     raeburn  8590:     if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439     raeburn  8591:         my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   8592:         my $now = time;
1.609     raeburn  8593:         my %displaystatus = ( previous => 'Expired',
                   8594:                               active   => 'Active',
                   8595:                               future   => 'Future',
                   8596:                             );
1.1075.2.36  raeburn  8597:         my (%nothide,@possdoms);
1.630     raeburn  8598:         if ($hidepriv) {
                   8599:             my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                   8600:             foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
                   8601:                 if ($user !~ /:/) {
                   8602:                     $nothide{join(':',split(/[\@]/,$user))}=1;
                   8603:                 } else {
                   8604:                     $nothide{$user} = 1;
                   8605:                 }
                   8606:             }
1.1075.2.36  raeburn  8607:             my @possdoms = ($cdom);
                   8608:             if ($coursehash{'checkforpriv'}) {
                   8609:                 push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
                   8610:             }
1.630     raeburn  8611:         }
1.439     raeburn  8612:         foreach my $person (sort(keys(%coursepersonnel))) {
1.288     raeburn  8613:             my $match = 0;
1.412     raeburn  8614:             my $secmatch = 0;
1.439     raeburn  8615:             my $status;
1.412     raeburn  8616:             my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275     raeburn  8617:             $user =~ s/:$//;
1.439     raeburn  8618:             my ($end,$start) = split(/:/,$coursepersonnel{$person});
                   8619:             if ($end == -1 || $start == -1) {
                   8620:                 next;
                   8621:             }
                   8622:             if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
                   8623:                 (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412     raeburn  8624:                 my ($uname,$udom) = split(/:/,$user);
                   8625:                 if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420     albertel 8626:                     if (grep(/^all$/,@{$sections})) {
1.412     raeburn  8627:                         $secmatch = 1;
                   8628:                     } elsif ($usec eq '') {
1.420     albertel 8629:                         if (grep(/^none$/,@{$sections})) {
1.412     raeburn  8630:                             $secmatch = 1;
                   8631:                         }
                   8632:                     } else {
                   8633:                         if (grep(/^\Q$usec\E$/,@{$sections})) {
                   8634:                             $secmatch = 1;
                   8635:                         }
                   8636:                     }
                   8637:                     if (!$secmatch) {
                   8638:                         next;
                   8639:                     }
1.288     raeburn  8640:                 }
1.419     raeburn  8641:                 if ($usec eq '') {
                   8642:                     $usec = 'none';
                   8643:                 }
1.275     raeburn  8644:                 if ($uname ne '' && $udom ne '') {
1.630     raeburn  8645:                     if ($hidepriv) {
1.1075.2.36  raeburn  8646:                         if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630     raeburn  8647:                             (!$nothide{$uname.':'.$udom})) {
                   8648:                             next;
                   8649:                         }
                   8650:                     }
1.503     raeburn  8651:                     if ($end > 0 && $end < $now) {
1.439     raeburn  8652:                         $status = 'previous';
                   8653:                     } elsif ($start > $now) {
                   8654:                         $status = 'future';
                   8655:                     } else {
                   8656:                         $status = 'active';
                   8657:                     }
1.277     albertel 8658:                     foreach my $type (keys(%{$types})) { 
1.275     raeburn  8659:                         if ($status eq $type) {
1.420     albertel 8660:                             if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419     raeburn  8661:                                 push(@{$$users{$role}{$user}},$type);
                   8662:                             }
1.288     raeburn  8663:                             $match = 1;
                   8664:                         }
                   8665:                     }
1.419     raeburn  8666:                     if (($match) && (ref($userdata) eq 'HASH')) {
                   8667:                         if (!exists($$userdata{$uname.':'.$udom})) {
                   8668: 			    &get_user_info($udom,$uname,\%idx,$userdata);
                   8669:                         }
1.420     albertel 8670:                         if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419     raeburn  8671:                             push(@{$seclists{$uname.':'.$udom}},$usec);
                   8672:                         }
1.609     raeburn  8673:                         if (ref($statushash) eq 'HASH') {
                   8674:                             $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
                   8675:                         }
1.275     raeburn  8676:                     }
                   8677:                 }
                   8678:             }
                   8679:         }
1.290     albertel 8680:         if (grep(/^ow$/,@{$roles})) {
1.279     raeburn  8681:             if ((defined($cdom)) && (defined($cnum))) {
                   8682:                 my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                   8683:                 if ( defined($csettings{'internal.courseowner'}) ) {
                   8684:                     my $owner = $csettings{'internal.courseowner'};
1.609     raeburn  8685:                     next if ($owner eq '');
                   8686:                     my ($ownername,$ownerdom);
                   8687:                     if ($owner =~ /^([^:]+):([^:]+)$/) {
                   8688:                         $ownername = $1;
                   8689:                         $ownerdom = $2;
                   8690:                     } else {
                   8691:                         $ownername = $owner;
                   8692:                         $ownerdom = $cdom;
                   8693:                         $owner = $ownername.':'.$ownerdom;
1.439     raeburn  8694:                     }
                   8695:                     @{$$users{'ow'}{$owner}} = 'any';
1.290     albertel 8696:                     if (defined($userdata) && 
1.609     raeburn  8697: 			!exists($$userdata{$owner})) {
                   8698: 			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
                   8699:                         if (!grep(/^none$/,@{$seclists{$owner}})) {
                   8700:                             push(@{$seclists{$owner}},'none');
                   8701:                         }
                   8702:                         if (ref($statushash) eq 'HASH') {
                   8703:                             $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419     raeburn  8704:                         }
1.290     albertel 8705: 		    }
1.279     raeburn  8706:                 }
                   8707:             }
                   8708:         }
1.419     raeburn  8709:         foreach my $user (keys(%seclists)) {
                   8710:             @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
                   8711:             $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
                   8712:         }
1.275     raeburn  8713:     }
                   8714:     return;
                   8715: }
                   8716: 
1.288     raeburn  8717: sub get_user_info {
                   8718:     my ($udom,$uname,$idx,$userdata) = @_;
1.289     albertel 8719:     $$userdata{$uname.':'.$udom}[$$idx{fullname}] = 
                   8720: 	&plainname($uname,$udom,'lastname');
1.291     albertel 8721:     $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297     raeburn  8722:     $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609     raeburn  8723:     my %idhash =  &Apache::lonnet::idrget($udom,($uname));
                   8724:     $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname}; 
1.288     raeburn  8725:     return;
                   8726: }
1.275     raeburn  8727: 
1.472     raeburn  8728: ###############################################
                   8729: 
                   8730: =pod
                   8731: 
                   8732: =item * &get_user_quota()
                   8733: 
1.1075.2.41  raeburn  8734: Retrieves quota assigned for storage of user files.
                   8735: Default is to report quota for portfolio files.
1.472     raeburn  8736: 
                   8737: Incoming parameters:
                   8738: 1. user's username
                   8739: 2. user's domain
1.1075.2.41  raeburn  8740: 3. quota name - portfolio, author, or course
                   8741:    (if no quota name provided, defaults to portfolio).
1.1075.2.59  raeburn  8742: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42  raeburn  8743:    course
1.472     raeburn  8744: 
                   8745: Returns:
1.1075.2.58  raeburn  8746: 1. Disk quota (in MB) assigned to student.
1.536     raeburn  8747: 2. (Optional) Type of setting: custom or default
                   8748:    (individually assigned or default for user's 
                   8749:    institutional status).
                   8750: 3. (Optional) - User's institutional status (e.g., faculty, staff
                   8751:    or student - types as defined in localenroll::inst_usertypes 
                   8752:    for user's domain, which determines default quota for user.
                   8753: 4. (Optional) - Default quota which would apply to the user.
1.472     raeburn  8754: 
                   8755: If a value has been stored in the user's environment, 
1.536     raeburn  8756: it will return that, otherwise it returns the maximal default
1.1075.2.41  raeburn  8757: defined for the user's institutional status(es) in the domain.
1.472     raeburn  8758: 
                   8759: =cut
                   8760: 
                   8761: ###############################################
                   8762: 
                   8763: 
                   8764: sub get_user_quota {
1.1075.2.42  raeburn  8765:     my ($uname,$udom,$quotaname,$crstype) = @_;
1.536     raeburn  8766:     my ($quota,$quotatype,$settingstatus,$defquota);
1.472     raeburn  8767:     if (!defined($udom)) {
                   8768:         $udom = $env{'user.domain'};
                   8769:     }
                   8770:     if (!defined($uname)) {
                   8771:         $uname = $env{'user.name'};
                   8772:     }
                   8773:     if (($udom eq '' || $uname eq '') ||
                   8774:         ($udom eq 'public') && ($uname eq 'public')) {
                   8775:         $quota = 0;
1.536     raeburn  8776:         $quotatype = 'default';
                   8777:         $defquota = 0; 
1.472     raeburn  8778:     } else {
1.536     raeburn  8779:         my $inststatus;
1.1075.2.41  raeburn  8780:         if ($quotaname eq 'course') {
                   8781:             if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
                   8782:                 ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
                   8783:                 $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
                   8784:             } else {
                   8785:                 my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
                   8786:                 $quota = $cenv{'internal.uploadquota'};
                   8787:             }
1.536     raeburn  8788:         } else {
1.1075.2.41  raeburn  8789:             if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
                   8790:                 if ($quotaname eq 'author') {
                   8791:                     $quota = $env{'environment.authorquota'};
                   8792:                 } else {
                   8793:                     $quota = $env{'environment.portfolioquota'};
                   8794:                 }
                   8795:                 $inststatus = $env{'environment.inststatus'};
                   8796:             } else {
                   8797:                 my %userenv = 
                   8798:                     &Apache::lonnet::get('environment',['portfolioquota',
                   8799:                                          'authorquota','inststatus'],$udom,$uname);
                   8800:                 my ($tmp) = keys(%userenv);
                   8801:                 if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   8802:                     if ($quotaname eq 'author') {
                   8803:                         $quota = $userenv{'authorquota'};
                   8804:                     } else {
                   8805:                         $quota = $userenv{'portfolioquota'};
                   8806:                     }
                   8807:                     $inststatus = $userenv{'inststatus'};
                   8808:                 } else {
                   8809:                     undef(%userenv);
                   8810:                 }
                   8811:             }
                   8812:         }
                   8813:         if ($quota eq '' || wantarray) {
                   8814:             if ($quotaname eq 'course') {
                   8815:                 my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59  raeburn  8816:                 if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
                   8817:                     ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42  raeburn  8818:                     $defquota = $domdefs{$crstype.'quota'};
                   8819:                 }
                   8820:                 if ($defquota eq '') {
                   8821:                     $defquota = 500;
                   8822:                 }
1.1075.2.41  raeburn  8823:             } else {
                   8824:                 ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
                   8825:             }
                   8826:             if ($quota eq '') {
                   8827:                 $quota = $defquota;
                   8828:                 $quotatype = 'default';
                   8829:             } else {
                   8830:                 $quotatype = 'custom';
                   8831:             }
1.472     raeburn  8832:         }
                   8833:     }
1.536     raeburn  8834:     if (wantarray) {
                   8835:         return ($quota,$quotatype,$settingstatus,$defquota);
                   8836:     } else {
                   8837:         return $quota;
                   8838:     }
1.472     raeburn  8839: }
                   8840: 
                   8841: ###############################################
                   8842: 
                   8843: =pod
                   8844: 
                   8845: =item * &default_quota()
                   8846: 
1.536     raeburn  8847: Retrieves default quota assigned for storage of user portfolio files,
                   8848: given an (optional) user's institutional status.
1.472     raeburn  8849: 
                   8850: Incoming parameters:
1.1075.2.42  raeburn  8851: 
1.472     raeburn  8852: 1. domain
1.536     raeburn  8853: 2. (Optional) institutional status(es).  This is a : separated list of 
                   8854:    status types (e.g., faculty, staff, student etc.)
                   8855:    which apply to the user for whom the default is being retrieved.
                   8856:    If the institutional status string in undefined, the domain
1.1075.2.41  raeburn  8857:    default quota will be returned.
                   8858: 3.  quota name - portfolio, author, or course
                   8859:    (if no quota name provided, defaults to portfolio).
1.472     raeburn  8860: 
                   8861: Returns:
1.1075.2.42  raeburn  8862: 
1.1075.2.58  raeburn  8863: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536     raeburn  8864: 2. (Optional) institutional type which determined the value of the
                   8865:    default quota.
1.472     raeburn  8866: 
                   8867: If a value has been stored in the domain's configuration db,
                   8868: it will return that, otherwise it returns 20 (for backwards 
                   8869: compatibility with domains which have not set up a configuration
1.1075.2.58  raeburn  8870: db file; the original statically defined portfolio quota was 20 MB). 
1.472     raeburn  8871: 
1.536     raeburn  8872: If the user's status includes multiple types (e.g., staff and student),
                   8873: the largest default quota which applies to the user determines the
                   8874: default quota returned.
                   8875: 
1.472     raeburn  8876: =cut
                   8877: 
                   8878: ###############################################
                   8879: 
                   8880: 
                   8881: sub default_quota {
1.1075.2.41  raeburn  8882:     my ($udom,$inststatus,$quotaname) = @_;
1.536     raeburn  8883:     my ($defquota,$settingstatus);
                   8884:     my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622     raeburn  8885:                                             ['quotas'],$udom);
1.1075.2.41  raeburn  8886:     my $key = 'defaultquota';
                   8887:     if ($quotaname eq 'author') {
                   8888:         $key = 'authorquota';
                   8889:     }
1.622     raeburn  8890:     if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536     raeburn  8891:         if ($inststatus ne '') {
1.765     raeburn  8892:             my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536     raeburn  8893:             foreach my $item (@statuses) {
1.1075.2.41  raeburn  8894:                 if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8895:                     if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711     raeburn  8896:                         if ($defquota eq '') {
1.1075.2.41  raeburn  8897:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8898:                             $settingstatus = $item;
1.1075.2.41  raeburn  8899:                         } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
                   8900:                             $defquota = $quotahash{'quotas'}{$key}{$item};
1.711     raeburn  8901:                             $settingstatus = $item;
                   8902:                         }
                   8903:                     }
1.1075.2.41  raeburn  8904:                 } elsif ($key eq 'defaultquota') {
1.711     raeburn  8905:                     if ($quotahash{'quotas'}{$item} ne '') {
                   8906:                         if ($defquota eq '') {
                   8907:                             $defquota = $quotahash{'quotas'}{$item};
                   8908:                             $settingstatus = $item;
                   8909:                         } elsif ($quotahash{'quotas'}{$item} > $defquota) {
                   8910:                             $defquota = $quotahash{'quotas'}{$item};
                   8911:                             $settingstatus = $item;
                   8912:                         }
1.536     raeburn  8913:                     }
                   8914:                 }
                   8915:             }
                   8916:         }
                   8917:         if ($defquota eq '') {
1.1075.2.41  raeburn  8918:             if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
                   8919:                 $defquota = $quotahash{'quotas'}{$key}{'default'};
                   8920:             } elsif ($key eq 'defaultquota') {
1.711     raeburn  8921:                 $defquota = $quotahash{'quotas'}{'default'};
                   8922:             }
1.536     raeburn  8923:             $settingstatus = 'default';
1.1075.2.42  raeburn  8924:             if ($defquota eq '') {
                   8925:                 if ($quotaname eq 'author') {
                   8926:                     $defquota = 500;
                   8927:                 }
                   8928:             }
1.536     raeburn  8929:         }
                   8930:     } else {
                   8931:         $settingstatus = 'default';
1.1075.2.41  raeburn  8932:         if ($quotaname eq 'author') {
                   8933:             $defquota = 500;
                   8934:         } else {
                   8935:             $defquota = 20;
                   8936:         }
1.536     raeburn  8937:     }
                   8938:     if (wantarray) {
                   8939:         return ($defquota,$settingstatus);
1.472     raeburn  8940:     } else {
1.536     raeburn  8941:         return $defquota;
1.472     raeburn  8942:     }
                   8943: }
                   8944: 
1.1075.2.41  raeburn  8945: ###############################################
                   8946: 
                   8947: =pod
                   8948: 
1.1075.2.42  raeburn  8949: =item * &excess_filesize_warning()
1.1075.2.41  raeburn  8950: 
                   8951: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42  raeburn  8952: of existing file within authoring space will cause quota for the authoring
                   8953: space to be exceeded.
                   8954: 
                   8955: Same, if upload of a file directly to a course/community via Course Editor
                   8956: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41  raeburn  8957: 
1.1075.2.61  raeburn  8958: Inputs: 7 
1.1075.2.42  raeburn  8959: 1. username or coursenum
1.1075.2.41  raeburn  8960: 2. domain
1.1075.2.42  raeburn  8961: 3. context ('author' or 'course')
1.1075.2.41  raeburn  8962: 4. filename of file for which action is being requested
                   8963: 5. filesize (kB) of file
                   8964: 6. action being taken: copy or upload.
1.1075.2.59  raeburn  8965: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41  raeburn  8966: 
                   8967: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
                   8968:          otherwise return null.
                   8969: 
1.1075.2.42  raeburn  8970: =back
                   8971: 
1.1075.2.41  raeburn  8972: =cut
                   8973: 
1.1075.2.42  raeburn  8974: sub excess_filesize_warning {
1.1075.2.59  raeburn  8975:     my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42  raeburn  8976:     my $current_disk_usage = 0;
1.1075.2.59  raeburn  8977:     my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42  raeburn  8978:     if ($context eq 'author') {
                   8979:         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
                   8980:         $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
                   8981:     } else {
                   8982:         foreach my $subdir ('docs','supplemental') {
                   8983:             $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
                   8984:         }
                   8985:     }
1.1075.2.41  raeburn  8986:     $disk_quota = int($disk_quota * 1000);
                   8987:     if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69  raeburn  8988:         return '<p class="LC_warning">'.
1.1075.2.41  raeburn  8989:                 &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69  raeburn  8990:                     '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
                   8991:                '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41  raeburn  8992:                             $disk_quota,$current_disk_usage).
                   8993:                '</p>';
                   8994:     }
                   8995:     return;
                   8996: }
                   8997: 
                   8998: ###############################################
                   8999: 
                   9000: 
1.384     raeburn  9001: sub get_secgrprole_info {
                   9002:     my ($cdom,$cnum,$needroles,$type)  = @_;
                   9003:     my %sections_count = &get_sections($cdom,$cnum);
                   9004:     my @sections =  (sort {$a <=> $b} keys(%sections_count));
                   9005:     my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
                   9006:     my @groups = sort(keys(%curr_groups));
                   9007:     my $allroles = [];
                   9008:     my $rolehash;
                   9009:     my $accesshash = {
                   9010:                      active => 'Currently has access',
                   9011:                      future => 'Will have future access',
                   9012:                      previous => 'Previously had access',
                   9013:                   };
                   9014:     if ($needroles) {
                   9015:         $rolehash = {'all' => 'all'};
1.385     albertel 9016:         my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
                   9017: 	if (&Apache::lonnet::error(%user_roles)) {
                   9018: 	    undef(%user_roles);
                   9019: 	}
                   9020:         foreach my $item (keys(%user_roles)) {
1.384     raeburn  9021:             my ($role)=split(/\:/,$item,2);
                   9022:             if ($role eq 'cr') { next; }
                   9023:             if ($role =~ /^cr/) {
                   9024:                 $$rolehash{$role} = (split('/',$role))[3];
                   9025:             } else {
                   9026:                 $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
                   9027:             }
                   9028:         }
                   9029:         foreach my $key (sort(keys(%{$rolehash}))) {
                   9030:             push(@{$allroles},$key);
                   9031:         }
                   9032:         push (@{$allroles},'st');
                   9033:         $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
                   9034:     }
                   9035:     return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
                   9036: }
                   9037: 
1.555     raeburn  9038: sub user_picker {
1.994     raeburn  9039:     my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555     raeburn  9040:     my $currdom = $dom;
                   9041:     my %curr_selected = (
                   9042:                         srchin => 'dom',
1.580     raeburn  9043:                         srchby => 'lastname',
1.555     raeburn  9044:                       );
                   9045:     my $srchterm;
1.625     raeburn  9046:     if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555     raeburn  9047:         if ($srch->{'srchby'} ne '') {
                   9048:             $curr_selected{'srchby'} = $srch->{'srchby'};
                   9049:         }
                   9050:         if ($srch->{'srchin'} ne '') {
                   9051:             $curr_selected{'srchin'} = $srch->{'srchin'};
                   9052:         }
                   9053:         if ($srch->{'srchtype'} ne '') {
                   9054:             $curr_selected{'srchtype'} = $srch->{'srchtype'};
                   9055:         }
                   9056:         if ($srch->{'srchdomain'} ne '') {
                   9057:             $currdom = $srch->{'srchdomain'};
                   9058:         }
                   9059:         $srchterm = $srch->{'srchterm'};
                   9060:     }
                   9061:     my %lt=&Apache::lonlocal::texthash(
1.573     raeburn  9062:                     'usr'       => 'Search criteria',
1.563     raeburn  9063:                     'doma'      => 'Domain/institution to search',
1.558     albertel 9064:                     'uname'     => 'username',
                   9065:                     'lastname'  => 'last name',
1.555     raeburn  9066:                     'lastfirst' => 'last name, first name',
1.558     albertel 9067:                     'crs'       => 'in this course',
1.576     raeburn  9068:                     'dom'       => 'in selected LON-CAPA domain', 
1.558     albertel 9069:                     'alc'       => 'all LON-CAPA',
1.573     raeburn  9070:                     'instd'     => 'in institutional directory for selected domain',
1.558     albertel 9071:                     'exact'     => 'is',
                   9072:                     'contains'  => 'contains',
1.569     raeburn  9073:                     'begins'    => 'begins with',
1.571     raeburn  9074:                     'youm'      => "You must include some text to search for.",
                   9075:                     'thte'      => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
                   9076:                     'thet'      => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
                   9077:                     'yomc'      => "You must choose a domain when using an institutional directory search.",
                   9078:                     'ymcd'      => "You must choose a domain when using a domain search.",
                   9079:                     'whus'      => "When using searching by last,first you must include a comma as separator between last name and first name.",
                   9080:                     'whse'      => "When searching by last,first you must include at least one character in the first name.",
                   9081:                      'thfo'     => "The following need to be corrected before the search can be run:",
1.555     raeburn  9082:                                        );
1.563     raeburn  9083:     my $domform = &select_dom_form($currdom,'srchdomain',1,1);
                   9084:     my $srchinsel = ' <select name="srchin">';
1.555     raeburn  9085: 
                   9086:     my @srchins = ('crs','dom','alc','instd');
                   9087: 
                   9088:     foreach my $option (@srchins) {
                   9089:         # FIXME 'alc' option unavailable until 
                   9090:         #       loncreateuser::print_user_query_page()
                   9091:         #       has been completed.
                   9092:         next if ($option eq 'alc');
1.880     raeburn  9093:         next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));  
1.555     raeburn  9094:         next if ($option eq 'crs' && !$env{'request.course.id'});
1.563     raeburn  9095:         if ($curr_selected{'srchin'} eq $option) {
                   9096:             $srchinsel .= ' 
                   9097:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9098:         } else {
                   9099:             $srchinsel .= '
                   9100:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9101:         }
1.555     raeburn  9102:     }
1.563     raeburn  9103:     $srchinsel .= "\n  </select>\n";
1.555     raeburn  9104: 
                   9105:     my $srchbysel =  ' <select name="srchby">';
1.580     raeburn  9106:     foreach my $option ('lastname','lastfirst','uname') {
1.555     raeburn  9107:         if ($curr_selected{'srchby'} eq $option) {
                   9108:             $srchbysel .= '
                   9109:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9110:         } else {
                   9111:             $srchbysel .= '
                   9112:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9113:          }
                   9114:     }
                   9115:     $srchbysel .= "\n  </select>\n";
                   9116: 
                   9117:     my $srchtypesel = ' <select name="srchtype">';
1.580     raeburn  9118:     foreach my $option ('begins','contains','exact') {
1.555     raeburn  9119:         if ($curr_selected{'srchtype'} eq $option) {
                   9120:             $srchtypesel .= '
                   9121:    <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
                   9122:         } else {
                   9123:             $srchtypesel .= '
                   9124:    <option value="'.$option.'">'.$lt{$option}.'</option>';
                   9125:         }
                   9126:     }
                   9127:     $srchtypesel .= "\n  </select>\n";
                   9128: 
1.558     albertel 9129:     my ($newuserscript,$new_user_create);
1.994     raeburn  9130:     my $context_dom = $env{'request.role.domain'};
                   9131:     if ($context eq 'requestcrs') {
                   9132:         if ($env{'form.coursedom'} ne '') { 
                   9133:             $context_dom = $env{'form.coursedom'};
                   9134:         }
                   9135:     }
1.556     raeburn  9136:     if ($forcenewuser) {
1.576     raeburn  9137:         if (ref($srch) eq 'HASH') {
1.994     raeburn  9138:             if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627     raeburn  9139:                 if ($cancreate) {
                   9140:                     $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>';
                   9141:                 } else {
1.799     bisitz   9142:                     my $helplink = 'javascript:helpMenu('."'display'".')';
1.627     raeburn  9143:                     my %usertypetext = (
                   9144:                         official   => 'institutional',
                   9145:                         unofficial => 'non-institutional',
                   9146:                     );
1.799     bisitz   9147:                     $new_user_create = '<p class="LC_warning">'
                   9148:                                       .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
                   9149:                                       .' '
                   9150:                                       .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
                   9151:                                           ,'<a href="'.$helplink.'">','</a>')
                   9152:                                       .'</p><br />';
1.627     raeburn  9153:                 }
1.576     raeburn  9154:             }
                   9155:         }
                   9156: 
1.556     raeburn  9157:         $newuserscript = <<"ENDSCRIPT";
                   9158: 
1.570     raeburn  9159: function setSearch(createnew,callingForm) {
1.556     raeburn  9160:     if (createnew == 1) {
1.570     raeburn  9161:         for (var i=0; i<callingForm.srchby.length; i++) {
                   9162:             if (callingForm.srchby.options[i].value == 'uname') {
                   9163:                 callingForm.srchby.selectedIndex = i;
1.556     raeburn  9164:             }
                   9165:         }
1.570     raeburn  9166:         for (var i=0; i<callingForm.srchin.length; i++) {
                   9167:             if ( callingForm.srchin.options[i].value == 'dom') {
                   9168: 		callingForm.srchin.selectedIndex = i;
1.556     raeburn  9169:             }
                   9170:         }
1.570     raeburn  9171:         for (var i=0; i<callingForm.srchtype.length; i++) {
                   9172:             if (callingForm.srchtype.options[i].value == 'exact') {
                   9173:                 callingForm.srchtype.selectedIndex = i;
1.556     raeburn  9174:             }
                   9175:         }
1.570     raeburn  9176:         for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994     raeburn  9177:             if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570     raeburn  9178:                 callingForm.srchdomain.selectedIndex = i;
1.556     raeburn  9179:             }
                   9180:         }
                   9181:     }
                   9182: }
                   9183: ENDSCRIPT
1.558     albertel 9184: 
1.556     raeburn  9185:     }
                   9186: 
1.555     raeburn  9187:     my $output = <<"END_BLOCK";
1.556     raeburn  9188: <script type="text/javascript">
1.824     bisitz   9189: // <![CDATA[
1.570     raeburn  9190: function validateEntry(callingForm) {
1.558     albertel 9191: 
1.556     raeburn  9192:     var checkok = 1;
1.558     albertel 9193:     var srchin;
1.570     raeburn  9194:     for (var i=0; i<callingForm.srchin.length; i++) {
                   9195: 	if ( callingForm.srchin[i].checked ) {
                   9196: 	    srchin = callingForm.srchin[i].value;
1.558     albertel 9197: 	}
                   9198:     }
                   9199: 
1.570     raeburn  9200:     var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
                   9201:     var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
                   9202:     var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
                   9203:     var srchterm =  callingForm.srchterm.value;
                   9204:     var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556     raeburn  9205:     var msg = "";
                   9206: 
                   9207:     if (srchterm == "") {
                   9208:         checkok = 0;
1.571     raeburn  9209:         msg += "$lt{'youm'}\\n";
1.556     raeburn  9210:     }
                   9211: 
1.569     raeburn  9212:     if (srchtype== 'begins') {
                   9213:         if (srchterm.length < 2) {
                   9214:             checkok = 0;
1.571     raeburn  9215:             msg += "$lt{'thte'}\\n";
1.569     raeburn  9216:         }
                   9217:     }
                   9218: 
1.556     raeburn  9219:     if (srchtype== 'contains') {
                   9220:         if (srchterm.length < 3) {
                   9221:             checkok = 0;
1.571     raeburn  9222:             msg += "$lt{'thet'}\\n";
1.556     raeburn  9223:         }
                   9224:     }
                   9225:     if (srchin == 'instd') {
                   9226:         if (srchdomain == '') {
                   9227:             checkok = 0;
1.571     raeburn  9228:             msg += "$lt{'yomc'}\\n";
1.556     raeburn  9229:         }
                   9230:     }
                   9231:     if (srchin == 'dom') {
                   9232:         if (srchdomain == '') {
                   9233:             checkok = 0;
1.571     raeburn  9234:             msg += "$lt{'ymcd'}\\n";
1.556     raeburn  9235:         }
                   9236:     }
                   9237:     if (srchby == 'lastfirst') {
                   9238:         if (srchterm.indexOf(",") == -1) {
                   9239:             checkok = 0;
1.571     raeburn  9240:             msg += "$lt{'whus'}\\n";
1.556     raeburn  9241:         }
                   9242:         if (srchterm.indexOf(",") == srchterm.length -1) {
                   9243:             checkok = 0;
1.571     raeburn  9244:             msg += "$lt{'whse'}\\n";
1.556     raeburn  9245:         }
                   9246:     }
                   9247:     if (checkok == 0) {
1.571     raeburn  9248:         alert("$lt{'thfo'}\\n"+msg);
1.556     raeburn  9249:         return;
                   9250:     }
                   9251:     if (checkok == 1) {
1.570     raeburn  9252:         callingForm.submit();
1.556     raeburn  9253:     }
                   9254: }
                   9255: 
                   9256: $newuserscript
                   9257: 
1.824     bisitz   9258: // ]]>
1.556     raeburn  9259: </script>
1.558     albertel 9260: 
                   9261: $new_user_create
                   9262: 
1.555     raeburn  9263: END_BLOCK
1.558     albertel 9264: 
1.876     raeburn  9265:     $output .= &Apache::lonhtmlcommon::start_pick_box().
                   9266:                &Apache::lonhtmlcommon::row_title($lt{'doma'}).
                   9267:                $domform.
                   9268:                &Apache::lonhtmlcommon::row_closure().
                   9269:                &Apache::lonhtmlcommon::row_title($lt{'usr'}).
                   9270:                $srchbysel.
                   9271:                $srchtypesel. 
                   9272:                '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
                   9273:                $srchinsel.
                   9274:                &Apache::lonhtmlcommon::row_closure(1). 
                   9275:                &Apache::lonhtmlcommon::end_pick_box().
                   9276:                '<br />';
1.555     raeburn  9277:     return $output;
                   9278: }
                   9279: 
1.612     raeburn  9280: sub user_rule_check {
1.615     raeburn  9281:     my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612     raeburn  9282:     my $response;
                   9283:     if (ref($usershash) eq 'HASH') {
                   9284:         foreach my $user (keys(%{$usershash})) {
                   9285:             my ($uname,$udom) = split(/:/,$user);
                   9286:             next if ($udom eq '' || $uname eq '');
1.615     raeburn  9287:             my ($id,$newuser);
1.612     raeburn  9288:             if (ref($usershash->{$user}) eq 'HASH') {
1.615     raeburn  9289:                 $newuser = $usershash->{$user}->{'newuser'};
1.612     raeburn  9290:                 $id = $usershash->{$user}->{'id'};
                   9291:             }
                   9292:             my $inst_response;
                   9293:             if (ref($checks) eq 'HASH') {
                   9294:                 if (defined($checks->{'username'})) {
1.615     raeburn  9295:                     ($inst_response,%{$inst_results->{$user}}) = 
1.612     raeburn  9296:                         &Apache::lonnet::get_instuser($udom,$uname);
                   9297:                 } elsif (defined($checks->{'id'})) {
1.615     raeburn  9298:                     ($inst_response,%{$inst_results->{$user}}) =
1.612     raeburn  9299:                         &Apache::lonnet::get_instuser($udom,undef,$id);
                   9300:                 }
1.615     raeburn  9301:             } else {
                   9302:                 ($inst_response,%{$inst_results->{$user}}) =
                   9303:                     &Apache::lonnet::get_instuser($udom,$uname);
                   9304:                 return;
1.612     raeburn  9305:             }
1.615     raeburn  9306:             if (!$got_rules->{$udom}) {
1.612     raeburn  9307:                 my %domconfig = &Apache::lonnet::get_dom('configuration',
                   9308:                                                   ['usercreation'],$udom);
                   9309:                 if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615     raeburn  9310:                     foreach my $item ('username','id') {
1.612     raeburn  9311:                         if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
                   9312:                             $$curr_rules{$udom}{$item} = 
                   9313:                                 $domconfig{'usercreation'}{$item.'_rule'};
1.585     raeburn  9314:                         }
                   9315:                     }
                   9316:                 }
1.615     raeburn  9317:                 $got_rules->{$udom} = 1;  
1.585     raeburn  9318:             }
1.612     raeburn  9319:             foreach my $item (keys(%{$checks})) {
                   9320:                 if (ref($$curr_rules{$udom}) eq 'HASH') {
                   9321:                     if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
                   9322:                         if (@{$$curr_rules{$udom}{$item}} > 0) {
                   9323:                             my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
                   9324:                             foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
                   9325:                                 if ($rule_check{$rule}) {
                   9326:                                     $$rulematch{$user}{$item} = $rule;
                   9327:                                     if ($inst_response eq 'ok') {
1.615     raeburn  9328:                                         if (ref($inst_results) eq 'HASH') {
                   9329:                                             if (ref($inst_results->{$user}) eq 'HASH') {
                   9330:                                                 if (keys(%{$inst_results->{$user}}) == 0) {
                   9331:                                                     $$alerts{$item}{$udom}{$uname} = 1;
                   9332:                                                 }
1.612     raeburn  9333:                                             }
                   9334:                                         }
1.615     raeburn  9335:                                     }
                   9336:                                     last;
1.585     raeburn  9337:                                 }
                   9338:                             }
                   9339:                         }
                   9340:                     }
                   9341:                 }
                   9342:             }
                   9343:         }
                   9344:     }
1.612     raeburn  9345:     return;
                   9346: }
                   9347: 
                   9348: sub user_rule_formats {
                   9349:     my ($domain,$domdesc,$curr_rules,$check) = @_;
                   9350:     my %text = ( 
                   9351:                  'username' => 'Usernames',
                   9352:                  'id'       => 'IDs',
                   9353:                );
                   9354:     my $output;
                   9355:     my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
                   9356:     if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
                   9357:         if (@{$ruleorder} > 0) {
1.1075.2.20  raeburn  9358:             $output = '<br />'.
                   9359:                       &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
                   9360:                           '<span class="LC_cusr_emph">','</span>',$domdesc).
                   9361:                       ' <ul>';
1.612     raeburn  9362:             foreach my $rule (@{$ruleorder}) {
                   9363:                 if (ref($curr_rules) eq 'ARRAY') {
                   9364:                     if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
                   9365:                         if (ref($rules->{$rule}) eq 'HASH') {
                   9366:                             $output .= '<li>'.$rules->{$rule}{'name'}.': '.
                   9367:                                         $rules->{$rule}{'desc'}.'</li>';
                   9368:                         }
                   9369:                     }
                   9370:                 }
                   9371:             }
                   9372:             $output .= '</ul>';
                   9373:         }
                   9374:     }
                   9375:     return $output;
                   9376: }
                   9377: 
                   9378: sub instrule_disallow_msg {
1.615     raeburn  9379:     my ($checkitem,$domdesc,$count,$mode) = @_;
1.612     raeburn  9380:     my $response;
                   9381:     my %text = (
                   9382:                   item   => 'username',
                   9383:                   items  => 'usernames',
                   9384:                   match  => 'matches',
                   9385:                   do     => 'does',
                   9386:                   action => 'a username',
                   9387:                   one    => 'one',
                   9388:                );
                   9389:     if ($count > 1) {
                   9390:         $text{'item'} = 'usernames';
                   9391:         $text{'match'} ='match';
                   9392:         $text{'do'} = 'do';
                   9393:         $text{'action'} = 'usernames',
                   9394:         $text{'one'} = 'ones';
                   9395:     }
                   9396:     if ($checkitem eq 'id') {
                   9397:         $text{'items'} = 'IDs';
                   9398:         $text{'item'} = 'ID';
                   9399:         $text{'action'} = 'an ID';
1.615     raeburn  9400:         if ($count > 1) {
                   9401:             $text{'item'} = 'IDs';
                   9402:             $text{'action'} = 'IDs';
                   9403:         }
1.612     raeburn  9404:     }
1.674     bisitz   9405:     $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  9406:     if ($mode eq 'upload') {
                   9407:         if ($checkitem eq 'username') {
                   9408:             $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'}.");
                   9409:         } elsif ($checkitem eq 'id') {
1.674     bisitz   9410:             $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  9411:         }
1.669     raeburn  9412:     } elsif ($mode eq 'selfcreate') {
                   9413:         if ($checkitem eq 'id') {
                   9414:             $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.");
                   9415:         }
1.615     raeburn  9416:     } else {
                   9417:         if ($checkitem eq 'username') {
                   9418:             $response .= &mt("You must choose $text{'action'} with a different format --  $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
                   9419:         } elsif ($checkitem eq 'id') {
                   9420:             $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.");
                   9421:         }
1.612     raeburn  9422:     }
                   9423:     return $response;
1.585     raeburn  9424: }
                   9425: 
1.624     raeburn  9426: sub personal_data_fieldtitles {
                   9427:     my %fieldtitles = &Apache::lonlocal::texthash (
                   9428:                         id => 'Student/Employee ID',
                   9429:                         permanentemail => 'E-mail address',
                   9430:                         lastname => 'Last Name',
                   9431:                         firstname => 'First Name',
                   9432:                         middlename => 'Middle Name',
                   9433:                         generation => 'Generation',
                   9434:                         gen => 'Generation',
1.765     raeburn  9435:                         inststatus => 'Affiliation',
1.624     raeburn  9436:                    );
                   9437:     return %fieldtitles;
                   9438: }
                   9439: 
1.642     raeburn  9440: sub sorted_inst_types {
                   9441:     my ($dom) = @_;
1.1075.2.70  raeburn  9442:     my ($usertypes,$order);
                   9443:     my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
                   9444:     if (ref($domdefaults{'inststatus'}) eq 'HASH') {
                   9445:         $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
                   9446:         $order = $domdefaults{'inststatus'}{'inststatusorder'};
                   9447:     } else {
                   9448:         ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
                   9449:     }
1.642     raeburn  9450:     my $othertitle = &mt('All users');
                   9451:     if ($env{'request.course.id'}) {
1.668     raeburn  9452:         $othertitle  = &mt('Any users');
1.642     raeburn  9453:     }
                   9454:     my @types;
                   9455:     if (ref($order) eq 'ARRAY') {
                   9456:         @types = @{$order};
                   9457:     }
                   9458:     if (@types == 0) {
                   9459:         if (ref($usertypes) eq 'HASH') {
                   9460:             @types = sort(keys(%{$usertypes}));
                   9461:         }
                   9462:     }
                   9463:     if (keys(%{$usertypes}) > 0) {
                   9464:         $othertitle = &mt('Other users');
                   9465:     }
                   9466:     return ($othertitle,$usertypes,\@types);
                   9467: }
                   9468: 
1.645     raeburn  9469: sub get_institutional_codes {
                   9470:     my ($settings,$allcourses,$LC_code) = @_;
                   9471: # Get complete list of course sections to update
                   9472:     my @currsections = ();
                   9473:     my @currxlists = ();
                   9474:     my $coursecode = $$settings{'internal.coursecode'};
                   9475: 
                   9476:     if ($$settings{'internal.sectionnums'} ne '') {
                   9477:         @currsections = split(/,/,$$settings{'internal.sectionnums'});
                   9478:     }
                   9479: 
                   9480:     if ($$settings{'internal.crosslistings'} ne '') {
                   9481:         @currxlists = split(/,/,$$settings{'internal.crosslistings'});
                   9482:     }
                   9483: 
                   9484:     if (@currxlists > 0) {
                   9485:         foreach (@currxlists) {
                   9486:             if (m/^([^:]+):(\w*)$/) {
                   9487:                 unless (grep/^$1$/,@{$allcourses}) {
                   9488:                     push @{$allcourses},$1;
                   9489:                     $$LC_code{$1} = $2;
                   9490:                 }
                   9491:             }
                   9492:         }
                   9493:     }
                   9494:  
                   9495:     if (@currsections > 0) {
                   9496:         foreach (@currsections) {
                   9497:             if (m/^(\w+):(\w*)$/) {
                   9498:                 my $sec = $coursecode.$1;
                   9499:                 my $lc_sec = $2;
                   9500:                 unless (grep/^$sec$/,@{$allcourses}) {
                   9501:                     push @{$allcourses},$sec;
                   9502:                     $$LC_code{$sec} = $lc_sec;
                   9503:                 }
                   9504:             }
                   9505:         }
                   9506:     }
                   9507:     return;
                   9508: }
                   9509: 
1.971     raeburn  9510: sub get_standard_codeitems {
                   9511:     return ('Year','Semester','Department','Number','Section');
                   9512: }
                   9513: 
1.112     bowersj2 9514: =pod
                   9515: 
1.780     raeburn  9516: =head1 Slot Helpers
                   9517: 
                   9518: =over 4
                   9519: 
                   9520: =item * sorted_slots()
                   9521: 
1.1040    raeburn  9522: Sorts an array of slot names in order of an optional sort key,
                   9523: default sort is by slot start time (earliest first). 
1.780     raeburn  9524: 
                   9525: Inputs:
                   9526: 
                   9527: =over 4
                   9528: 
                   9529: slotsarr  - Reference to array of unsorted slot names.
                   9530: 
                   9531: slots     - Reference to hash of hash, where outer hash keys are slot names.
                   9532: 
1.1040    raeburn  9533: sortkey   - Name of key in inner hash to be sorted on (e.g., starttime).
                   9534: 
1.549     albertel 9535: =back
                   9536: 
1.780     raeburn  9537: Returns:
                   9538: 
                   9539: =over 4
                   9540: 
1.1040    raeburn  9541: sorted   - An array of slot names sorted by a specified sort key 
                   9542:            (default sort key is start time of the slot).
1.780     raeburn  9543: 
                   9544: =back
                   9545: 
                   9546: =cut
                   9547: 
                   9548: 
                   9549: sub sorted_slots {
1.1040    raeburn  9550:     my ($slotsarr,$slots,$sortkey) = @_;
                   9551:     if ($sortkey eq '') {
                   9552:         $sortkey = 'starttime';
                   9553:     }
1.780     raeburn  9554:     my @sorted;
                   9555:     if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
                   9556:         @sorted =
                   9557:             sort {
                   9558:                      if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040    raeburn  9559:                          return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780     raeburn  9560:                      }
                   9561:                      if (ref($slots->{$a})) { return -1;}
                   9562:                      if (ref($slots->{$b})) { return 1;}
                   9563:                      return 0;
                   9564:                  } @{$slotsarr};
                   9565:     }
                   9566:     return @sorted;
                   9567: }
                   9568: 
1.1040    raeburn  9569: =pod
                   9570: 
                   9571: =item * get_future_slots()
                   9572: 
                   9573: Inputs:
                   9574: 
                   9575: =over 4
                   9576: 
                   9577: cnum - course number
                   9578: 
                   9579: cdom - course domain
                   9580: 
                   9581: now - current UNIX time
                   9582: 
                   9583: symb - optional symb
                   9584: 
                   9585: =back
                   9586: 
                   9587: Returns:
                   9588: 
                   9589: =over 4
                   9590: 
                   9591: sorted_reservable - ref to array of student_schedulable slots currently 
                   9592:                     reservable, ordered by end date of reservation period.
                   9593: 
                   9594: reservable_now - ref to hash of student_schedulable slots currently
                   9595:                  reservable.
                   9596: 
                   9597:     Keys in inner hash are:
                   9598:     (a) symb: either blank or symb to which slot use is restricted.
                   9599:     (b) endreserve: end date of reservation period. 
                   9600: 
                   9601: sorted_future - ref to array of student_schedulable slots reservable in
                   9602:                 the future, ordered by start date of reservation period.
                   9603: 
                   9604: future_reservable - ref to hash of student_schedulable slots reservable
                   9605:                     in the future.
                   9606: 
                   9607:     Keys in inner hash are:
                   9608:     (a) symb: either blank or symb to which slot use is restricted.
                   9609:     (b) startreserve:  start date of reservation period.
                   9610: 
                   9611: =back
                   9612: 
                   9613: =cut
                   9614: 
                   9615: sub get_future_slots {
                   9616:     my ($cnum,$cdom,$now,$symb) = @_;
                   9617:     my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
                   9618:     my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
                   9619:     foreach my $slot (keys(%slots)) {
                   9620:         next unless($slots{$slot}->{'type'} eq 'schedulable_student');
                   9621:         if ($symb) {
                   9622:             next if (($slots{$slot}->{'symb'} ne '') && 
                   9623:                      ($slots{$slot}->{'symb'} ne $symb));
                   9624:         }
                   9625:         if (($slots{$slot}->{'starttime'} > $now) &&
                   9626:             ($slots{$slot}->{'endtime'} > $now)) {
                   9627:             if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
                   9628:                 my $userallowed = 0;
                   9629:                 if ($slots{$slot}->{'allowedsections'}) {
                   9630:                     my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
                   9631:                     if (!defined($env{'request.role.sec'})
                   9632:                         && grep(/^No section assigned$/,@allowed_sec)) {
                   9633:                         $userallowed=1;
                   9634:                     } else {
                   9635:                         if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
                   9636:                             $userallowed=1;
                   9637:                         }
                   9638:                     }
                   9639:                     unless ($userallowed) {
                   9640:                         if (defined($env{'request.course.groups'})) {
                   9641:                             my @groups = split(/:/,$env{'request.course.groups'});
                   9642:                             foreach my $group (@groups) {
                   9643:                                 if (grep(/^\Q$group\E$/,@allowed_sec)) {
                   9644:                                     $userallowed=1;
                   9645:                                     last;
                   9646:                                 }
                   9647:                             }
                   9648:                         }
                   9649:                     }
                   9650:                 }
                   9651:                 if ($slots{$slot}->{'allowedusers'}) {
                   9652:                     my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
                   9653:                     my $user = $env{'user.name'}.':'.$env{'user.domain'};
                   9654:                     if (grep(/^\Q$user\E$/,@allowed_users)) {
                   9655:                         $userallowed = 1;
                   9656:                     }
                   9657:                 }
                   9658:                 next unless($userallowed);
                   9659:             }
                   9660:             my $startreserve = $slots{$slot}->{'startreserve'};
                   9661:             my $endreserve = $slots{$slot}->{'endreserve'};
                   9662:             my $symb = $slots{$slot}->{'symb'};
                   9663:             if (($startreserve < $now) &&
                   9664:                 (!$endreserve || $endreserve > $now)) {
                   9665:                 my $lastres = $endreserve;
                   9666:                 if (!$lastres) {
                   9667:                     $lastres = $slots{$slot}->{'starttime'};
                   9668:                 }
                   9669:                 $reservable_now{$slot} = {
                   9670:                                            symb       => $symb,
                   9671:                                            endreserve => $lastres
                   9672:                                          };
                   9673:             } elsif (($startreserve > $now) &&
                   9674:                      (!$endreserve || $endreserve > $startreserve)) {
                   9675:                 $future_reservable{$slot} = {
                   9676:                                               symb         => $symb,
                   9677:                                               startreserve => $startreserve
                   9678:                                             };
                   9679:             }
                   9680:         }
                   9681:     }
                   9682:     my @unsorted_reservable = keys(%reservable_now);
                   9683:     if (@unsorted_reservable > 0) {
                   9684:         @sorted_reservable = 
                   9685:             &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
                   9686:     }
                   9687:     my @unsorted_future = keys(%future_reservable);
                   9688:     if (@unsorted_future > 0) {
                   9689:         @sorted_future =
                   9690:             &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
                   9691:     }
                   9692:     return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
                   9693: }
1.780     raeburn  9694: 
                   9695: =pod
                   9696: 
1.1057    foxr     9697: =back
                   9698: 
1.549     albertel 9699: =head1 HTTP Helpers
                   9700: 
                   9701: =over 4
                   9702: 
1.648     raeburn  9703: =item * &get_unprocessed_cgi($query,$possible_names)
1.112     bowersj2 9704: 
1.258     albertel 9705: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112     bowersj2 9706: $query.  The parameters listed in $possible_names (an array reference),
1.258     albertel 9707: will be set in $env{'form.name'} if they do not already exist.
1.112     bowersj2 9708: 
                   9709: Typically called with $ENV{'QUERY_STRING'} as the first parameter.  
                   9710: $possible_names is an ref to an array of form element names.  As an example:
                   9711: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258     albertel 9712: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112     bowersj2 9713: 
                   9714: =cut
1.1       albertel 9715: 
1.6       albertel 9716: sub get_unprocessed_cgi {
1.25      albertel 9717:   my ($query,$possible_names)= @_;
1.26      matthew  9718:   # $Apache::lonxml::debug=1;
1.356     albertel 9719:   foreach my $pair (split(/&/,$query)) {
                   9720:     my ($name, $value) = split(/=/,$pair);
1.369     www      9721:     $name = &unescape($name);
1.25      albertel 9722:     if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
                   9723:       $value =~ tr/+/ /;
                   9724:       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258     albertel 9725:       unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25      albertel 9726:     }
1.16      harris41 9727:   }
1.6       albertel 9728: }
                   9729: 
1.112     bowersj2 9730: =pod
                   9731: 
1.648     raeburn  9732: =item * &cacheheader() 
1.112     bowersj2 9733: 
                   9734: returns cache-controlling header code
                   9735: 
                   9736: =cut
                   9737: 
1.7       albertel 9738: sub cacheheader {
1.258     albertel 9739:     unless ($env{'request.method'} eq 'GET') { return ''; }
1.216     albertel 9740:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
                   9741:     my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7       albertel 9742:                 <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
                   9743:                 <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216     albertel 9744:     return $output;
1.7       albertel 9745: }
                   9746: 
1.112     bowersj2 9747: =pod
                   9748: 
1.648     raeburn  9749: =item * &no_cache($r) 
1.112     bowersj2 9750: 
                   9751: specifies header code to not have cache
                   9752: 
                   9753: =cut
                   9754: 
1.9       albertel 9755: sub no_cache {
1.216     albertel 9756:     my ($r) = @_;
                   9757:     if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258     albertel 9758: 	$env{'request.method'} ne 'GET') { return ''; }
1.216     albertel 9759:     my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
                   9760:     $r->no_cache(1);
                   9761:     $r->header_out("Expires" => $date);
                   9762:     $r->header_out("Pragma" => "no-cache");
1.123     www      9763: }
                   9764: 
                   9765: sub content_type {
1.181     albertel 9766:     my ($r,$type,$charset) = @_;
1.299     foxr     9767:     if ($r) {
                   9768: 	#  Note that printout.pl calls this with undef for $r.
                   9769: 	&no_cache($r);
                   9770:     }
1.258     albertel 9771:     if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181     albertel 9772:     unless ($charset) {
                   9773: 	$charset=&Apache::lonlocal::current_encoding;
                   9774:     }
                   9775:     if ($charset) { $type.='; charset='.$charset; }
                   9776:     if ($r) {
                   9777: 	$r->content_type($type);
                   9778:     } else {
                   9779: 	print("Content-type: $type\n\n");
                   9780:     }
1.9       albertel 9781: }
1.25      albertel 9782: 
1.112     bowersj2 9783: =pod
                   9784: 
1.648     raeburn  9785: =item * &add_to_env($name,$value) 
1.112     bowersj2 9786: 
1.258     albertel 9787: adds $name to the %env hash with value
1.112     bowersj2 9788: $value, if $name already exists, the entry is converted to an array
                   9789: reference and $value is added to the array.
                   9790: 
                   9791: =cut
                   9792: 
1.25      albertel 9793: sub add_to_env {
                   9794:   my ($name,$value)=@_;
1.258     albertel 9795:   if (defined($env{$name})) {
                   9796:     if (ref($env{$name})) {
1.25      albertel 9797:       #already have multiple values
1.258     albertel 9798:       push(@{ $env{$name} },$value);
1.25      albertel 9799:     } else {
                   9800:       #first time seeing multiple values, convert hash entry to an arrayref
1.258     albertel 9801:       my $first=$env{$name};
                   9802:       undef($env{$name});
                   9803:       push(@{ $env{$name} },$first,$value);
1.25      albertel 9804:     }
                   9805:   } else {
1.258     albertel 9806:     $env{$name}=$value;
1.25      albertel 9807:   }
1.31      albertel 9808: }
1.149     albertel 9809: 
                   9810: =pod
                   9811: 
1.648     raeburn  9812: =item * &get_env_multiple($name) 
1.149     albertel 9813: 
1.258     albertel 9814: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149     albertel 9815: values may be defined and end up as an array ref.
                   9816: 
                   9817: returns an array of values
                   9818: 
                   9819: =cut
                   9820: 
                   9821: sub get_env_multiple {
                   9822:     my ($name) = @_;
                   9823:     my @values;
1.258     albertel 9824:     if (defined($env{$name})) {
1.149     albertel 9825:         # exists is it an array
1.258     albertel 9826:         if (ref($env{$name})) {
                   9827:             @values=@{ $env{$name} };
1.149     albertel 9828:         } else {
1.258     albertel 9829:             $values[0]=$env{$name};
1.149     albertel 9830:         }
                   9831:     }
                   9832:     return(@values);
                   9833: }
                   9834: 
1.660     raeburn  9835: sub ask_for_embedded_content {
                   9836:     my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071    raeburn  9837:     my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11  raeburn  9838:         %currsubfile,%unused,$rem);
1.1071    raeburn  9839:     my $counter = 0;
                   9840:     my $numnew = 0;
1.987     raeburn  9841:     my $numremref = 0;
                   9842:     my $numinvalid = 0;
                   9843:     my $numpathchg = 0;
                   9844:     my $numexisting = 0;
1.1071    raeburn  9845:     my $numunused = 0;
                   9846:     my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53  raeburn  9847:         $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071    raeburn  9848:     my $heading = &mt('Upload embedded files');
                   9849:     my $buttontext = &mt('Upload');
                   9850: 
1.1075.2.11  raeburn  9851:     if ($env{'request.course.id'}) {
1.1075.2.35  raeburn  9852:         if ($actionurl eq '/adm/dependencies') {
                   9853:             $navmap = Apache::lonnavmaps::navmap->new();
                   9854:         }
                   9855:         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   9856:         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11  raeburn  9857:     }
1.1075.2.35  raeburn  9858:     if (($actionurl eq '/adm/portfolio') ||
                   9859:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984     raeburn  9860:         my $current_path='/';
                   9861:         if ($env{'form.currentpath'}) {
                   9862:             $current_path = $env{'form.currentpath'};
                   9863:         }
                   9864:         if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35  raeburn  9865:             $udom = $cdom;
                   9866:             $uname = $cnum;
1.984     raeburn  9867:             $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
                   9868:         } else {
                   9869:             $udom = $env{'user.domain'};
                   9870:             $uname = $env{'user.name'};
                   9871:             $url = '/userfiles/portfolio';
                   9872:         }
1.987     raeburn  9873:         $toplevel = $url.'/';
1.984     raeburn  9874:         $url .= $current_path;
                   9875:         $getpropath = 1;
1.987     raeburn  9876:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
                   9877:              ($actionurl eq '/adm/imsimport')) { 
1.1022    www      9878:         my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026    raeburn  9879:         $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987     raeburn  9880:         $toplevel = $url;
1.984     raeburn  9881:         if ($rest ne '') {
1.987     raeburn  9882:             $url .= $rest;
                   9883:         }
                   9884:     } elsif ($actionurl eq '/adm/coursedocs') {
                   9885:         if (ref($args) eq 'HASH') {
1.1071    raeburn  9886:             $url = $args->{'docs_url'};
                   9887:             $toplevel = $url;
1.1075.2.11  raeburn  9888:             if ($args->{'context'} eq 'paste') {
                   9889:                 ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
                   9890:                 ($path) =
                   9891:                     ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9892:                 $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9893:                 $fileloc =~ s{^/}{};
                   9894:             }
1.1071    raeburn  9895:         }
                   9896:     } elsif ($actionurl eq '/adm/dependencies') {
                   9897:         if ($env{'request.course.id'} ne '') {
                   9898:             if (ref($args) eq 'HASH') {
                   9899:                 $url = $args->{'docs_url'};
                   9900:                 $title = $args->{'docs_title'};
1.1075.2.35  raeburn  9901:                 $toplevel = $url;
                   9902:                 unless ($toplevel =~ m{^/}) {
                   9903:                     $toplevel = "/$url";
                   9904:                 }
1.1075.2.11  raeburn  9905:                 ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35  raeburn  9906:                 if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
                   9907:                     $path = $1;
                   9908:                 } else {
                   9909:                     ($path) =
                   9910:                         ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
                   9911:                 }
1.1075.2.79  raeburn  9912:                 if ($toplevel=~/^\/*(uploaded|editupload)/) {
                   9913:                     $fileloc = $toplevel;
                   9914:                     $fileloc=~ s/^\s*(\S+)\s*$/$1/;
                   9915:                     my ($udom,$uname,$fname) =
                   9916:                         ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
                   9917:                     $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
                   9918:                 } else {
                   9919:                     $fileloc = &Apache::lonnet::filelocation('',$toplevel);
                   9920:                 }
1.1071    raeburn  9921:                 $fileloc =~ s{^/}{};
                   9922:                 ($filename) = ($fileloc =~ m{.+/([^/]+)$});
                   9923:                 $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
                   9924:             }
1.987     raeburn  9925:         }
1.1075.2.35  raeburn  9926:     } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   9927:         $udom = $cdom;
                   9928:         $uname = $cnum;
                   9929:         $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
                   9930:         $toplevel = $url;
                   9931:         $path = $url;
                   9932:         $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
                   9933:         $fileloc =~ s{^/}{};
                   9934:     }
                   9935:     foreach my $file (keys(%{$allfiles})) {
                   9936:         my $embed_file;
                   9937:         if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
                   9938:             $embed_file = $1;
                   9939:         } else {
                   9940:             $embed_file = $file;
                   9941:         }
1.1075.2.55  raeburn  9942:         my ($absolutepath,$cleaned_file);
                   9943:         if ($embed_file =~ m{^\w+://}) {
                   9944:             $cleaned_file = $embed_file;
1.1075.2.47  raeburn  9945:             $newfiles{$cleaned_file} = 1;
                   9946:             $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9947:         } else {
1.1075.2.55  raeburn  9948:             $cleaned_file = &clean_path($embed_file);
1.987     raeburn  9949:             if ($embed_file =~ m{^/}) {
                   9950:                 $absolutepath = $embed_file;
                   9951:             }
1.1075.2.47  raeburn  9952:             if ($cleaned_file =~ m{/}) {
                   9953:                 my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987     raeburn  9954:                 $path = &check_for_traversal($path,$url,$toplevel);
                   9955:                 my $item = $fname;
                   9956:                 if ($path ne '') {
                   9957:                     $item = $path.'/'.$fname;
                   9958:                     $subdependencies{$path}{$fname} = 1;
                   9959:                 } else {
                   9960:                     $dependencies{$item} = 1;
                   9961:                 }
                   9962:                 if ($absolutepath) {
                   9963:                     $mapping{$item} = $absolutepath;
                   9964:                 } else {
                   9965:                     $mapping{$item} = $embed_file;
                   9966:                 }
                   9967:             } else {
                   9968:                 $dependencies{$embed_file} = 1;
                   9969:                 if ($absolutepath) {
1.1075.2.47  raeburn  9970:                     $mapping{$cleaned_file} = $absolutepath;
1.987     raeburn  9971:                 } else {
1.1075.2.47  raeburn  9972:                     $mapping{$cleaned_file} = $embed_file;
1.987     raeburn  9973:                 }
                   9974:             }
1.984     raeburn  9975:         }
                   9976:     }
1.1071    raeburn  9977:     my $dirptr = 16384;
1.984     raeburn  9978:     foreach my $path (keys(%subdependencies)) {
1.1071    raeburn  9979:         $currsubfile{$path} = {};
1.1075.2.35  raeburn  9980:         if (($actionurl eq '/adm/portfolio') ||
                   9981:             ($actionurl eq '/adm/coursegrp_portfolio')) { 
1.1021    raeburn  9982:             my ($sublistref,$listerror) =
                   9983:                 &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
                   9984:             if (ref($sublistref) eq 'ARRAY') {
                   9985:                 foreach my $line (@{$sublistref}) {
                   9986:                     my ($file_name,$rest) = split(/\&/,$line,2);
1.1071    raeburn  9987:                     $currsubfile{$path}{$file_name} = 1;
1.1021    raeburn  9988:                 }
1.984     raeburn  9989:             }
1.987     raeburn  9990:         } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  9991:             if (opendir(my $dir,$url.'/'.$path)) {
                   9992:                 my @subdir_list = grep(!/^\./,readdir($dir));
1.1071    raeburn  9993:                 map {$currsubfile{$path}{$_} = 1;} @subdir_list;
                   9994:             }
1.1075.2.11  raeburn  9995:         } elsif (($actionurl eq '/adm/dependencies') ||
                   9996:                  (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  9997:                   ($args->{'context'} eq 'paste')) ||
                   9998:                  ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  9999:             if ($env{'request.course.id'} ne '') {
1.1075.2.35  raeburn  10000:                 my $dir;
                   10001:                 if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
                   10002:                     $dir = $fileloc;
                   10003:                 } else {
                   10004:                     ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10005:                 }
1.1071    raeburn  10006:                 if ($dir ne '') {
                   10007:                     my ($sublistref,$listerror) =
                   10008:                         &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
                   10009:                     if (ref($sublistref) eq 'ARRAY') {
                   10010:                         foreach my $line (@{$sublistref}) {
                   10011:                             my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
                   10012:                                 undef,$mtime)=split(/\&/,$line,12);
                   10013:                             unless (($testdir&$dirptr) ||
                   10014:                                     ($file_name =~ /^\.\.?$/)) {
                   10015:                                 $currsubfile{$path}{$file_name} = [$size,$mtime];
                   10016:                             }
                   10017:                         }
                   10018:                     }
                   10019:                 }
1.984     raeburn  10020:             }
                   10021:         }
                   10022:         foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071    raeburn  10023:             if (exists($currsubfile{$path}{$file})) {
1.987     raeburn  10024:                 my $item = $path.'/'.$file;
                   10025:                 unless ($mapping{$item} eq $item) {
                   10026:                     $pathchanges{$item} = 1;
                   10027:                 }
                   10028:                 $existing{$item} = 1;
                   10029:                 $numexisting ++;
                   10030:             } else {
                   10031:                 $newfiles{$path.'/'.$file} = 1;
1.984     raeburn  10032:             }
                   10033:         }
1.1071    raeburn  10034:         if ($actionurl eq '/adm/dependencies') {
                   10035:             foreach my $path (keys(%currsubfile)) {
                   10036:                 if (ref($currsubfile{$path}) eq 'HASH') {
                   10037:                     foreach my $file (keys(%{$currsubfile{$path}})) {
                   10038:                          unless ($subdependencies{$path}{$file}) {
1.1075.2.11  raeburn  10039:                              next if (($rem ne '') &&
                   10040:                                       (($env{"httpref.$rem"."$path/$file"} ne '') ||
                   10041:                                        (ref($navmap) &&
                   10042:                                        (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
                   10043:                                         (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10044:                                          ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071    raeburn  10045:                              $unused{$path.'/'.$file} = 1; 
                   10046:                          }
                   10047:                     }
                   10048:                 }
                   10049:             }
                   10050:         }
1.984     raeburn  10051:     }
1.987     raeburn  10052:     my %currfile;
1.1075.2.35  raeburn  10053:     if (($actionurl eq '/adm/portfolio') ||
                   10054:         ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021    raeburn  10055:         my ($dirlistref,$listerror) =
                   10056:             &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
                   10057:         if (ref($dirlistref) eq 'ARRAY') {
                   10058:             foreach my $line (@{$dirlistref}) {
                   10059:                 my ($file_name,$rest) = split(/\&/,$line,2);
                   10060:                 $currfile{$file_name} = 1;
                   10061:             }
1.984     raeburn  10062:         }
1.987     raeburn  10063:     } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984     raeburn  10064:         if (opendir(my $dir,$url)) {
1.987     raeburn  10065:             my @dir_list = grep(!/^\./,readdir($dir));
1.984     raeburn  10066:             map {$currfile{$_} = 1;} @dir_list;
                   10067:         }
1.1075.2.11  raeburn  10068:     } elsif (($actionurl eq '/adm/dependencies') ||
                   10069:              (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35  raeburn  10070:               ($args->{'context'} eq 'paste')) ||
                   10071:              ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071    raeburn  10072:         if ($env{'request.course.id'} ne '') {
                   10073:             my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
                   10074:             if ($dir ne '') {
                   10075:                 my ($dirlistref,$listerror) =
                   10076:                     &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
                   10077:                 if (ref($dirlistref) eq 'ARRAY') {
                   10078:                     foreach my $line (@{$dirlistref}) {
                   10079:                         my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
                   10080:                             $size,undef,$mtime)=split(/\&/,$line,12);
                   10081:                         unless (($testdir&$dirptr) ||
                   10082:                                 ($file_name =~ /^\.\.?$/)) {
                   10083:                             $currfile{$file_name} = [$size,$mtime];
                   10084:                         }
                   10085:                     }
                   10086:                 }
                   10087:             }
                   10088:         }
1.984     raeburn  10089:     }
                   10090:     foreach my $file (keys(%dependencies)) {
1.1071    raeburn  10091:         if (exists($currfile{$file})) {
1.987     raeburn  10092:             unless ($mapping{$file} eq $file) {
                   10093:                 $pathchanges{$file} = 1;
                   10094:             }
                   10095:             $existing{$file} = 1;
                   10096:             $numexisting ++;
                   10097:         } else {
1.984     raeburn  10098:             $newfiles{$file} = 1;
                   10099:         }
                   10100:     }
1.1071    raeburn  10101:     foreach my $file (keys(%currfile)) {
                   10102:         unless (($file eq $filename) ||
                   10103:                 ($file eq $filename.'.bak') ||
                   10104:                 ($dependencies{$file})) {
1.1075.2.11  raeburn  10105:             if ($actionurl eq '/adm/dependencies') {
1.1075.2.35  raeburn  10106:                 unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
                   10107:                     next if (($rem ne '') &&
                   10108:                              (($env{"httpref.$rem".$file} ne '') ||
                   10109:                               (ref($navmap) &&
                   10110:                               (($navmap->getResourceByUrl($rem.$file) ne '') ||
                   10111:                                (($file =~ /^(.*\.s?html?)\.bak$/i) &&
                   10112:                                 ($navmap->getResourceByUrl($rem.$1)))))));
                   10113:                 }
1.1075.2.11  raeburn  10114:             }
1.1071    raeburn  10115:             $unused{$file} = 1;
                   10116:         }
                   10117:     }
1.1075.2.11  raeburn  10118:     if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
                   10119:         ($args->{'context'} eq 'paste')) {
                   10120:         $counter = scalar(keys(%existing));
                   10121:         $numpathchg = scalar(keys(%pathchanges));
                   10122:         return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35  raeburn  10123:     } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
                   10124:              (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
                   10125:         $counter = scalar(keys(%existing));
                   10126:         $numpathchg = scalar(keys(%pathchanges));
                   10127:         return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11  raeburn  10128:     }
1.984     raeburn  10129:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071    raeburn  10130:         if ($actionurl eq '/adm/dependencies') {
                   10131:             next if ($embed_file =~ m{^\w+://});
                   10132:         }
1.660     raeburn  10133:         $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10134:                           '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
1.1071    raeburn  10135:                           '<span class="LC_filename">'.$embed_file.'</span>';
1.987     raeburn  10136:         unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35  raeburn  10137:             $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
                   10138:                               &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987     raeburn  10139:         }
1.1075.2.35  raeburn  10140:         $upload_output .= '</td>';
1.1071    raeburn  10141:         if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) { 
1.1075.2.35  raeburn  10142:             $upload_output.='<td align="right">'.
                   10143:                             '<span class="LC_info LC_fontsize_medium">'.
                   10144:                             &mt("URL points to web address").'</span>';
1.987     raeburn  10145:             $numremref++;
1.660     raeburn  10146:         } elsif ($args->{'error_on_invalid_names'}
                   10147:             && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35  raeburn  10148:             $upload_output.='<td align="right"><span class="LC_warning">'.
                   10149:                             &mt('Invalid characters').'</span>';
1.987     raeburn  10150:             $numinvalid++;
1.660     raeburn  10151:         } else {
1.1075.2.35  raeburn  10152:             $upload_output .= '<td>'.
                   10153:                               &embedded_file_element('upload_embedded',$counter,
1.987     raeburn  10154:                                                      $embed_file,\%mapping,
1.1071    raeburn  10155:                                                      $allfiles,$codebase,'upload');
                   10156:             $counter ++;
                   10157:             $numnew ++;
1.987     raeburn  10158:         }
                   10159:         $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
                   10160:     }
                   10161:     foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071    raeburn  10162:         if ($actionurl eq '/adm/dependencies') {
                   10163:             my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
                   10164:             $modify_output .= &start_data_table_row().
                   10165:                               '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
                   10166:                               '<img src="'.&icon($embed_file).'" border="0" />'.
                   10167:                               '&nbsp;<span class="LC_filename">'.$embed_file.'</span></a></td>'.
                   10168:                               '<td>'.$size.'</td>'.
                   10169:                               '<td>'.$mtime.'</td>'.
                   10170:                               '<td><label><input type="checkbox" name="mod_upload_dep" '.
                   10171:                               'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
                   10172:                               $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
                   10173:                               '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
                   10174:                               &embedded_file_element('upload_embedded',$counter,
                   10175:                                                      $embed_file,\%mapping,
                   10176:                                                      $allfiles,$codebase,'modify').
                   10177:                               '</div></td>'.
                   10178:                               &end_data_table_row()."\n";
                   10179:             $counter ++;
                   10180:         } else {
                   10181:             $upload_output .= &start_data_table_row().
1.1075.2.35  raeburn  10182:                               '<td valign="top"><img src="'.&icon($embed_file).'" />&nbsp;'.
                   10183:                               '<span class="LC_filename">'.$embed_file.'</span></td>'.
                   10184:                               '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071    raeburn  10185:                               &Apache::loncommon::end_data_table_row()."\n";
                   10186:         }
                   10187:     }
                   10188:     my $delidx = $counter;
                   10189:     foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
                   10190:         my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
                   10191:         $delete_output .= &start_data_table_row().
                   10192:                           '<td><img src="'.&icon($oldfile).'" />'.
                   10193:                           '&nbsp;<span class="LC_filename">'.$oldfile.'</span></td>'.
                   10194:                           '<td>'.$size.'</td>'.
                   10195:                           '<td>'.$mtime.'</td>'.
                   10196:                           '<td><label><input type="checkbox" name="del_upload_dep" '.
                   10197:                           ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
                   10198:                           &embedded_file_element('upload_embedded',$delidx,
                   10199:                                                  $oldfile,\%mapping,$allfiles,
                   10200:                                                  $codebase,'delete').'</td>'.
                   10201:                           &end_data_table_row()."\n"; 
                   10202:         $numunused ++;
                   10203:         $delidx ++;
1.987     raeburn  10204:     }
                   10205:     if ($upload_output) {
                   10206:         $upload_output = &start_data_table().
                   10207:                          $upload_output.
                   10208:                          &end_data_table()."\n";
                   10209:     }
1.1071    raeburn  10210:     if ($modify_output) {
                   10211:         $modify_output = &start_data_table().
                   10212:                          &start_data_table_header_row().
                   10213:                          '<th>'.&mt('File').'</th>'.
                   10214:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10215:                          '<th>'.&mt('Modified').'</th>'.
                   10216:                          '<th>'.&mt('Upload replacement?').'</th>'.
                   10217:                          &end_data_table_header_row().
                   10218:                          $modify_output.
                   10219:                          &end_data_table()."\n";
                   10220:     }
                   10221:     if ($delete_output) {
                   10222:         $delete_output = &start_data_table().
                   10223:                          &start_data_table_header_row().
                   10224:                          '<th>'.&mt('File').'</th>'.
                   10225:                          '<th>'.&mt('Size (KB)').'</th>'.
                   10226:                          '<th>'.&mt('Modified').'</th>'.
                   10227:                          '<th>'.&mt('Delete?').'</th>'.
                   10228:                          &end_data_table_header_row().
                   10229:                          $delete_output.
                   10230:                          &end_data_table()."\n";
                   10231:     }
1.987     raeburn  10232:     my $applies = 0;
                   10233:     if ($numremref) {
                   10234:         $applies ++;
                   10235:     }
                   10236:     if ($numinvalid) {
                   10237:         $applies ++;
                   10238:     }
                   10239:     if ($numexisting) {
                   10240:         $applies ++;
                   10241:     }
1.1071    raeburn  10242:     if ($counter || $numunused) {
1.987     raeburn  10243:         $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
                   10244:                   ' method="post" enctype="multipart/form-data">'."\n".
1.1071    raeburn  10245:                   $state.'<h3>'.$heading.'</h3>'; 
                   10246:         if ($actionurl eq '/adm/dependencies') {
                   10247:             if ($numnew) {
                   10248:                 $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
                   10249:                            '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
                   10250:                            $upload_output.'<br />'."\n";
                   10251:             }
                   10252:             if ($numexisting) {
                   10253:                 $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
                   10254:                            '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
                   10255:                            $modify_output.'<br />'."\n";
                   10256:                            $buttontext = &mt('Save changes');
                   10257:             }
                   10258:             if ($numunused) {
                   10259:                 $output .= '<h4>'.&mt('Unused files').'</h4>'.
                   10260:                            '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
                   10261:                            $delete_output.'<br />'."\n";
                   10262:                            $buttontext = &mt('Save changes');
                   10263:             }
                   10264:         } else {
                   10265:             $output .= $upload_output.'<br />'."\n";
                   10266:         }
                   10267:         $output .= '<input type ="hidden" name="number_embedded_items" value="'.
                   10268:                    $counter.'" />'."\n";
                   10269:         if ($actionurl eq '/adm/dependencies') { 
                   10270:             $output .= '<input type ="hidden" name="number_newemb_items" value="'.
                   10271:                        $numnew.'" />'."\n";
                   10272:         } elsif ($actionurl eq '') {
1.987     raeburn  10273:             $output .=  '<input type="hidden" name="phase" value="three" />';
                   10274:         }
                   10275:     } elsif ($applies) {
                   10276:         $output = '<b>'.&mt('Referenced files').'</b>:<br />';
                   10277:         if ($applies > 1) {
                   10278:             $output .=  
1.1075.2.35  raeburn  10279:                 &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987     raeburn  10280:             if ($numremref) {
                   10281:                 $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
                   10282:             }
                   10283:             if ($numinvalid) {
                   10284:                 $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
                   10285:             }
                   10286:             if ($numexisting) {
                   10287:                 $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
                   10288:             }
                   10289:             $output .= '</ul><br />';
                   10290:         } elsif ($numremref) {
                   10291:             $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
                   10292:         } elsif ($numinvalid) {
                   10293:             $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
                   10294:         } elsif ($numexisting) {
                   10295:             $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
                   10296:         }
                   10297:         $output .= $upload_output.'<br />';
                   10298:     }
                   10299:     my ($pathchange_output,$chgcount);
1.1071    raeburn  10300:     $chgcount = $counter;
1.987     raeburn  10301:     if (keys(%pathchanges) > 0) {
                   10302:         foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071    raeburn  10303:             if ($counter) {
1.987     raeburn  10304:                 $output .= &embedded_file_element('pathchange',$chgcount,
                   10305:                                                   $embed_file,\%mapping,
1.1071    raeburn  10306:                                                   $allfiles,$codebase,'change');
1.987     raeburn  10307:             } else {
                   10308:                 $pathchange_output .= 
                   10309:                     &start_data_table_row().
                   10310:                     '<td><input type ="checkbox" name="namechange" value="'.
                   10311:                     $chgcount.'" checked="checked" /></td>'.
                   10312:                     '<td>'.$mapping{$embed_file}.'</td>'.
                   10313:                     '<td>'.$embed_file.
                   10314:                     &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071    raeburn  10315:                                            \%mapping,$allfiles,$codebase,'change').
1.987     raeburn  10316:                     '</td>'.&end_data_table_row();
1.660     raeburn  10317:             }
1.987     raeburn  10318:             $numpathchg ++;
                   10319:             $chgcount ++;
1.660     raeburn  10320:         }
                   10321:     }
1.1075.2.35  raeburn  10322:     if (($counter) || ($numunused)) {
1.987     raeburn  10323:         if ($numpathchg) {
                   10324:             $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
                   10325:                        $numpathchg.'" />'."\n";
                   10326:         }
                   10327:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') || 
                   10328:             ($actionurl eq '/adm/imsimport')) {
                   10329:             $output .= '<input type="hidden" name="phase" value="three" />'."\n";
                   10330:         } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
                   10331:             $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071    raeburn  10332:         } elsif ($actionurl eq '/adm/dependencies') {
                   10333:             $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987     raeburn  10334:         }
1.1075.2.35  raeburn  10335:         $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987     raeburn  10336:     } elsif ($numpathchg) {
                   10337:         my %pathchange = ();
                   10338:         $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
                   10339:         if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10340:             $output .= '<p>'.&mt('or').'</p>'; 
1.1075.2.35  raeburn  10341:         }
1.987     raeburn  10342:     }
1.1071    raeburn  10343:     return ($output,$counter,$numpathchg);
1.987     raeburn  10344: }
                   10345: 
1.1075.2.47  raeburn  10346: =pod
                   10347: 
                   10348: =item * clean_path($name)
                   10349: 
                   10350: Performs clean-up of directories, subdirectories and filename in an
                   10351: embedded object, referenced in an HTML file which is being uploaded
                   10352: to a course or portfolio, where
                   10353: "Upload embedded images/multimedia files if HTML file" checkbox was
                   10354: checked.
                   10355: 
                   10356: Clean-up is similar to replacements in lonnet::clean_filename()
                   10357: except each / between sub-directory and next level is preserved.
                   10358: 
                   10359: =cut
                   10360: 
                   10361: sub clean_path {
                   10362:     my ($embed_file) = @_;
                   10363:     $embed_file =~s{^/+}{};
                   10364:     my @contents;
                   10365:     if ($embed_file =~ m{/}) {
                   10366:         @contents = split(/\//,$embed_file);
                   10367:     } else {
                   10368:         @contents = ($embed_file);
                   10369:     }
                   10370:     my $lastidx = scalar(@contents)-1;
                   10371:     for (my $i=0; $i<=$lastidx; $i++) {
                   10372:         $contents[$i]=~s{\\}{/}g;
                   10373:         $contents[$i]=~s/\s+/\_/g;
                   10374:         $contents[$i]=~s{[^/\w\.\-]}{}g;
                   10375:         if ($i == $lastidx) {
                   10376:             $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
                   10377:         }
                   10378:     }
                   10379:     if ($lastidx > 0) {
                   10380:         return join('/',@contents);
                   10381:     } else {
                   10382:         return $contents[0];
                   10383:     }
                   10384: }
                   10385: 
1.987     raeburn  10386: sub embedded_file_element {
1.1071    raeburn  10387:     my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987     raeburn  10388:     return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
                   10389:                    (ref($codebase) eq 'HASH'));
                   10390:     my $output;
1.1071    raeburn  10391:     if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987     raeburn  10392:        $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
                   10393:     }
                   10394:     $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
                   10395:                &escape($embed_file).'" />';
                   10396:     unless (($context eq 'upload_embedded') && 
                   10397:             ($mapping->{$embed_file} eq $embed_file)) {
                   10398:         $output .='
                   10399:         <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
                   10400:     }
                   10401:     my $attrib;
                   10402:     if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
                   10403:         $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
                   10404:     }
                   10405:     $output .=
                   10406:         "\n\t\t".
                   10407:         '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
                   10408:         $attrib.'" />';
                   10409:     if (exists($codebase->{$mapping->{$embed_file}})) {
                   10410:         $output .=
                   10411:             "\n\t\t".
                   10412:             '<input name="codebase_'.$num.'" type="hidden" value="'.
                   10413:             &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984     raeburn  10414:     }
1.987     raeburn  10415:     return $output;
1.660     raeburn  10416: }
                   10417: 
1.1071    raeburn  10418: sub get_dependency_details {
                   10419:     my ($currfile,$currsubfile,$embed_file) = @_;
                   10420:     my ($size,$mtime,$showsize,$showmtime);
                   10421:     if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
                   10422:         if ($embed_file =~ m{/}) {
                   10423:             my ($path,$fname) = split(/\//,$embed_file);
                   10424:             if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
                   10425:                 ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
                   10426:             }
                   10427:         } else {
                   10428:             if (ref($currfile->{$embed_file}) eq 'ARRAY') {
                   10429:                 ($size,$mtime) = @{$currfile->{$embed_file}};
                   10430:             }
                   10431:         }
                   10432:         $showsize = $size/1024.0;
                   10433:         $showsize = sprintf("%.1f",$showsize);
                   10434:         if ($mtime > 0) {
                   10435:             $showmtime = &Apache::lonlocal::locallocaltime($mtime);
                   10436:         }
                   10437:     }
                   10438:     return ($showsize,$showmtime);
                   10439: }
                   10440: 
                   10441: sub ask_embedded_js {
                   10442:     return <<"END";
                   10443: <script type="text/javascript"">
                   10444: // <![CDATA[
                   10445: function toggleBrowse(counter) {
                   10446:     var chkboxid = document.getElementById('mod_upload_dep_'+counter);
                   10447:     var fileid = document.getElementById('embedded_item_'+counter);
                   10448:     var uploaddivid = document.getElementById('moduploaddep_'+counter);
                   10449:     if (chkboxid.checked == true) {
                   10450:         uploaddivid.style.display='block';
                   10451:     } else {
                   10452:         uploaddivid.style.display='none';
                   10453:         fileid.value = '';
                   10454:     }
                   10455: }
                   10456: // ]]>
                   10457: </script>
                   10458: 
                   10459: END
                   10460: }
                   10461: 
1.661     raeburn  10462: sub upload_embedded {
                   10463:     my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987     raeburn  10464:         $current_disk_usage,$hiddenstate,$actionurl) = @_;
                   10465:     my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661     raeburn  10466:     for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
                   10467:         next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
                   10468:         my $orig_uploaded_filename =
                   10469:             $env{'form.embedded_item_'.$i.'.filename'};
1.987     raeburn  10470:         foreach my $type ('orig','ref','attrib','codebase') {
                   10471:             if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
                   10472:                 $env{'form.embedded_'.$type.'_'.$i} =
                   10473:                     &unescape($env{'form.embedded_'.$type.'_'.$i});
                   10474:             }
                   10475:         }
1.661     raeburn  10476:         my ($path,$fname) =
                   10477:             ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
                   10478:         # no path, whole string is fname
                   10479:         if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
                   10480:         $fname = &Apache::lonnet::clean_filename($fname);
                   10481:         # See if there is anything left
                   10482:         next if ($fname eq '');
                   10483: 
                   10484:         # Check if file already exists as a file or directory.
                   10485:         my ($state,$msg);
                   10486:         if ($context eq 'portfolio') {
                   10487:             my $port_path = $dirpath;
                   10488:             if ($group ne '') {
                   10489:                 $port_path = "groups/$group/$port_path";
                   10490:             }
1.987     raeburn  10491:             ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
                   10492:                                               $fname,$group,'embedded_item_'.$i,
1.661     raeburn  10493:                                               $dir_root,$port_path,$disk_quota,
                   10494:                                               $current_disk_usage,$uname,$udom);
                   10495:             if ($state eq 'will_exceed_quota'
1.984     raeburn  10496:                 || $state eq 'file_locked') {
1.661     raeburn  10497:                 $output .= $msg;
                   10498:                 next;
                   10499:             }
                   10500:         } elsif (($context eq 'author') || ($context eq 'testbank')) {
                   10501:             ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
                   10502:             if ($state eq 'exists') {
                   10503:                 $output .= $msg;
                   10504:                 next;
                   10505:             }
                   10506:         }
                   10507:         # Check if extension is valid
                   10508:         if (($fname =~ /\.(\w+)$/) &&
                   10509:             (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53  raeburn  10510:             $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
                   10511:                       .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661     raeburn  10512:             next;
                   10513:         } elsif (($fname =~ /\.(\w+)$/) &&
                   10514:                  (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987     raeburn  10515:             $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661     raeburn  10516:             next;
                   10517:         } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34  raeburn  10518:             $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  10519:             next;
                   10520:         }
                   10521:         $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35  raeburn  10522:         my $subdir = $path;
                   10523:         $subdir =~ s{/+$}{};
1.661     raeburn  10524:         if ($context eq 'portfolio') {
1.984     raeburn  10525:             my $result;
                   10526:             if ($state eq 'existingfile') {
                   10527:                 $result=
                   10528:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35  raeburn  10529:                                                     $dirpath.$env{'form.currentpath'}.$subdir);
1.661     raeburn  10530:             } else {
1.984     raeburn  10531:                 $result=
                   10532:                     &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987     raeburn  10533:                                                     $dirpath.
1.1075.2.35  raeburn  10534:                                                     $env{'form.currentpath'}.$subdir);
1.984     raeburn  10535:                 if ($result !~ m|^/uploaded/|) {
                   10536:                     $output .= '<span class="LC_error">'
                   10537:                                .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10538:                                ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10539:                                .'</span><br />';
                   10540:                     next;
                   10541:                 } else {
1.987     raeburn  10542:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10543:                                $path.$fname.'</span>').'<br />';     
1.984     raeburn  10544:                 }
1.661     raeburn  10545:             }
1.1075.2.35  raeburn  10546:         } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
                   10547:             my $extendedsubdir = $dirpath.'/'.$subdir;
                   10548:             $extendedsubdir =~ s{/+$}{};
1.987     raeburn  10549:             my $result =
1.1075.2.35  raeburn  10550:                 &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987     raeburn  10551:             if ($result !~ m|^/uploaded/|) {
                   10552:                 $output .= '<span class="LC_error">'
                   10553:                            .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
                   10554:                            ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
                   10555:                            .'</span><br />';
                   10556:                     next;
                   10557:             } else {
                   10558:                 $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10559:                            $path.$fname.'</span>').'<br />';
1.1075.2.35  raeburn  10560:                 if ($context eq 'syllabus') {
                   10561:                     &Apache::lonnet::make_public_indefinitely($result);
                   10562:                 }
1.987     raeburn  10563:             }
1.661     raeburn  10564:         } else {
                   10565: # Save the file
                   10566:             my $target = $env{'form.embedded_item_'.$i};
                   10567:             my $fullpath = $dir_root.$dirpath.'/'.$path;
                   10568:             my $dest = $fullpath.$fname;
                   10569:             my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027    raeburn  10570:             my @parts=split(/\//,"$dirpath/$path");
1.661     raeburn  10571:             my $count;
                   10572:             my $filepath = $dir_root;
1.1027    raeburn  10573:             foreach my $subdir (@parts) {
                   10574:                 $filepath .= "/$subdir";
                   10575:                 if (!-e $filepath) {
1.661     raeburn  10576:                     mkdir($filepath,0770);
                   10577:                 }
                   10578:             }
                   10579:             my $fh;
                   10580:             if (!open($fh,'>'.$dest)) {
                   10581:                 &Apache::lonnet::logthis('Failed to create '.$dest);
                   10582:                 $output .= '<span class="LC_error">'.
1.1071    raeburn  10583:                            &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
                   10584:                                $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10585:                            '</span><br />';
                   10586:             } else {
                   10587:                 if (!print $fh $env{'form.embedded_item_'.$i}) {
                   10588:                     &Apache::lonnet::logthis('Failed to write to '.$dest);
                   10589:                     $output .= '<span class="LC_error">'.
1.1071    raeburn  10590:                               &mt('An error occurred while writing the file [_1] for embedded element [_2].',
                   10591:                                   $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661     raeburn  10592:                               '</span><br />';
                   10593:                 } else {
1.987     raeburn  10594:                     $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
                   10595:                                $url.'</span>').'<br />';
                   10596:                     unless ($context eq 'testbank') {
                   10597:                         $footer .= &mt('View embedded file: [_1]',
                   10598:                                        '<a href="'.$url.'">'.$fname.'</a>').'<br />';
                   10599:                     }
                   10600:                 }
                   10601:                 close($fh);
                   10602:             }
                   10603:         }
                   10604:         if ($env{'form.embedded_ref_'.$i}) {
                   10605:             $pathchange{$i} = 1;
                   10606:         }
                   10607:     }
                   10608:     if ($output) {
                   10609:         $output = '<p>'.$output.'</p>';
                   10610:     }
                   10611:     $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
                   10612:     $returnflag = 'ok';
1.1071    raeburn  10613:     my $numpathchgs = scalar(keys(%pathchange));
                   10614:     if ($numpathchgs > 0) {
1.987     raeburn  10615:         if ($context eq 'portfolio') {
                   10616:             $output .= '<p>'.&mt('or').'</p>';
                   10617:         } elsif ($context eq 'testbank') {
1.1071    raeburn  10618:             $output .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
                   10619:                                   '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987     raeburn  10620:             $returnflag = 'modify_orightml';
                   10621:         }
                   10622:     }
1.1071    raeburn  10623:     return ($output.$footer,$returnflag,$numpathchgs);
1.987     raeburn  10624: }
                   10625: 
                   10626: sub modify_html_form {
                   10627:     my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
                   10628:     my $end = 0;
                   10629:     my $modifyform;
                   10630:     if ($context eq 'upload_embedded') {
                   10631:         return unless (ref($pathchange) eq 'HASH');
                   10632:         if ($env{'form.number_embedded_items'}) {
                   10633:             $end += $env{'form.number_embedded_items'};
                   10634:         }
                   10635:         if ($env{'form.number_pathchange_items'}) {
                   10636:             $end += $env{'form.number_pathchange_items'};
                   10637:         }
                   10638:         if ($end) {
                   10639:             for (my $i=0; $i<$end; $i++) {
                   10640:                 if ($i < $env{'form.number_embedded_items'}) {
                   10641:                     next unless($pathchange->{$i});
                   10642:                 }
                   10643:                 $modifyform .=
                   10644:                     &start_data_table_row().
                   10645:                     '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
                   10646:                     'checked="checked" /></td>'.
                   10647:                     '<td>'.$env{'form.embedded_ref_'.$i}.
                   10648:                     '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
                   10649:                     &escape($env{'form.embedded_ref_'.$i}).'" />'.
                   10650:                     '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
                   10651:                     &escape($env{'form.embedded_codebase_'.$i}).'" />'.
                   10652:                     '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
                   10653:                     &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
                   10654:                     '<td>'.$env{'form.embedded_orig_'.$i}.
                   10655:                     '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
                   10656:                     &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
                   10657:                     &end_data_table_row();
1.1071    raeburn  10658:             }
1.987     raeburn  10659:         }
                   10660:     } else {
                   10661:         $modifyform = $pathchgtable;
                   10662:         if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
                   10663:             $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
                   10664:         } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
                   10665:             $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
                   10666:         }
                   10667:     }
                   10668:     if ($modifyform) {
1.1071    raeburn  10669:         if ($actionurl eq '/adm/dependencies') {
                   10670:             $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
                   10671:         }
1.987     raeburn  10672:         return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
                   10673:                '<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".
                   10674:                '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
                   10675:                '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
                   10676:                '</ol></p>'."\n".'<p>'.
                   10677:                &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
                   10678:                '<form method="post" name="refchanger" action="'.$actionurl.'">'.
                   10679:                &start_data_table()."\n".
                   10680:                &start_data_table_header_row().
                   10681:                '<th>'.&mt('Change?').'</th>'.
                   10682:                '<th>'.&mt('Current reference').'</th>'.
                   10683:                '<th>'.&mt('Required reference').'</th>'.
                   10684:                &end_data_table_header_row()."\n".
                   10685:                $modifyform.
                   10686:                &end_data_table().'<br />'."\n".$hiddenstate.
                   10687:                '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
                   10688:                '</form>'."\n";
                   10689:     }
                   10690:     return;
                   10691: }
                   10692: 
                   10693: sub modify_html_refs {
1.1075.2.35  raeburn  10694:     my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987     raeburn  10695:     my $container;
                   10696:     if ($context eq 'portfolio') {
                   10697:         $container = $env{'form.container'};
                   10698:     } elsif ($context eq 'coursedoc') {
                   10699:         $container = $env{'form.primaryurl'};
1.1071    raeburn  10700:     } elsif ($context eq 'manage_dependencies') {
                   10701:         (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
                   10702:         $container = "/$container";
1.1075.2.35  raeburn  10703:     } elsif ($context eq 'syllabus') {
                   10704:         $container = $url;
1.987     raeburn  10705:     } else {
1.1027    raeburn  10706:         $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987     raeburn  10707:     }
                   10708:     my (%allfiles,%codebase,$output,$content);
                   10709:     my @changes = &get_env_multiple('form.namechange');
1.1075.2.35  raeburn  10710:     unless ((@changes > 0)  || ($context eq 'syllabus')) {
1.1071    raeburn  10711:         if (wantarray) {
                   10712:             return ('',0,0); 
                   10713:         } else {
                   10714:             return;
                   10715:         }
                   10716:     }
                   10717:     if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10718:         ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071    raeburn  10719:         unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
                   10720:             if (wantarray) {
                   10721:                 return ('',0,0);
                   10722:             } else {
                   10723:                 return;
                   10724:             }
                   10725:         } 
1.987     raeburn  10726:         $content = &Apache::lonnet::getfile($container);
1.1071    raeburn  10727:         if ($content eq '-1') {
                   10728:             if (wantarray) {
                   10729:                 return ('',0,0);
                   10730:             } else {
                   10731:                 return;
                   10732:             }
                   10733:         }
1.987     raeburn  10734:     } else {
1.1071    raeburn  10735:         unless ($container =~ /^\Q$dir_root\E/) {
                   10736:             if (wantarray) {
                   10737:                 return ('',0,0);
                   10738:             } else {
                   10739:                 return;
                   10740:             }
                   10741:         } 
1.987     raeburn  10742:         if (open(my $fh,"<$container")) {
                   10743:             $content = join('', <$fh>);
                   10744:             close($fh);
                   10745:         } else {
1.1071    raeburn  10746:             if (wantarray) {
                   10747:                 return ('',0,0);
                   10748:             } else {
                   10749:                 return;
                   10750:             }
1.987     raeburn  10751:         }
                   10752:     }
                   10753:     my ($count,$codebasecount) = (0,0);
                   10754:     my $mm = new File::MMagic;
                   10755:     my $mime_type = $mm->checktype_contents($content);
                   10756:     if ($mime_type eq 'text/html') {
                   10757:         my $parse_result = 
                   10758:             &Apache::lonnet::extract_embedded_items($container,\%allfiles,
                   10759:                                                     \%codebase,\$content);
                   10760:         if ($parse_result eq 'ok') {
                   10761:             foreach my $i (@changes) {
                   10762:                 my $orig = &unescape($env{'form.embedded_orig_'.$i});
                   10763:                 my $ref = &unescape($env{'form.embedded_ref_'.$i});
                   10764:                 if ($allfiles{$ref}) {
                   10765:                     my $newname =  $orig;
                   10766:                     my ($attrib_regexp,$codebase);
1.1006    raeburn  10767:                     $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987     raeburn  10768:                     if ($attrib_regexp =~ /:/) {
                   10769:                         $attrib_regexp =~ s/\:/|/g;
                   10770:                     }
                   10771:                     if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10772:                         my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10773:                         $count += $numchg;
1.1075.2.35  raeburn  10774:                         $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48  raeburn  10775:                         delete($allfiles{$ref});
1.987     raeburn  10776:                     }
                   10777:                     if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006    raeburn  10778:                         $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987     raeburn  10779:                         my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
                   10780:                         $codebasecount ++;
                   10781:                     }
                   10782:                 }
                   10783:             }
1.1075.2.35  raeburn  10784:             my $skiprewrites;
1.987     raeburn  10785:             if ($count || $codebasecount) {
                   10786:                 my $saveresult;
1.1071    raeburn  10787:                 if (($context eq 'portfolio') || ($context eq 'coursedoc') || 
1.1075.2.35  raeburn  10788:                     ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987     raeburn  10789:                     my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10790:                     if ($url eq $container) {
                   10791:                         my ($fname) = ($container =~ m{/([^/]+)$});
                   10792:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10793:                                             $count,'<span class="LC_filename">'.
1.1071    raeburn  10794:                                             $fname.'</span>').'</p>';
1.987     raeburn  10795:                     } else {
                   10796:                          $output = '<p class="LC_error">'.
                   10797:                                    &mt('Error: update failed for: [_1].',
                   10798:                                    '<span class="LC_filename">'.
                   10799:                                    $container.'</span>').'</p>';
                   10800:                     }
1.1075.2.35  raeburn  10801:                     if ($context eq 'syllabus') {
                   10802:                         unless ($saveresult eq 'ok') {
                   10803:                             $skiprewrites = 1;
                   10804:                         }
                   10805:                     }
1.987     raeburn  10806:                 } else {
                   10807:                     if (open(my $fh,">$container")) {
                   10808:                         print $fh $content;
                   10809:                         close($fh);
                   10810:                         $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
                   10811:                                   $count,'<span class="LC_filename">'.
                   10812:                                   $container.'</span>').'</p>';
1.661     raeburn  10813:                     } else {
1.987     raeburn  10814:                          $output = '<p class="LC_error">'.
                   10815:                                    &mt('Error: could not update [_1].',
                   10816:                                    '<span class="LC_filename">'.
                   10817:                                    $container.'</span>').'</p>';
1.661     raeburn  10818:                     }
                   10819:                 }
                   10820:             }
1.1075.2.35  raeburn  10821:             if (($context eq 'syllabus') && (!$skiprewrites)) {
                   10822:                 my ($actionurl,$state);
                   10823:                 $actionurl = "/public/$udom/$uname/syllabus";
                   10824:                 my ($ignore,$num,$numpathchanges,$existing,$mapping) =
                   10825:                     &ask_for_embedded_content($actionurl,$state,\%allfiles,
                   10826:                                               \%codebase,
                   10827:                                               {'context' => 'rewrites',
                   10828:                                                'ignore_remote_references' => 1,});
                   10829:                 if (ref($mapping) eq 'HASH') {
                   10830:                     my $rewrites = 0;
                   10831:                     foreach my $key (keys(%{$mapping})) {
                   10832:                         next if ($key =~ m{^https?://});
                   10833:                         my $ref = $mapping->{$key};
                   10834:                         my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
                   10835:                         my $attrib;
                   10836:                         if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
                   10837:                             $attrib = join('|',@{$allfiles{$mapping->{$key}}});
                   10838:                         }
                   10839:                         if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
                   10840:                             my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
                   10841:                             $rewrites += $numchg;
                   10842:                         }
                   10843:                     }
                   10844:                     if ($rewrites) {
                   10845:                         my $saveresult;
                   10846:                         my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
                   10847:                         if ($url eq $container) {
                   10848:                             my ($fname) = ($container =~ m{/([^/]+)$});
                   10849:                             $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
                   10850:                                             $count,'<span class="LC_filename">'.
                   10851:                                             $fname.'</span>').'</p>';
                   10852:                         } else {
                   10853:                             $output .= '<p class="LC_error">'.
                   10854:                                        &mt('Error: could not update links in [_1].',
                   10855:                                        '<span class="LC_filename">'.
                   10856:                                        $container.'</span>').'</p>';
                   10857: 
                   10858:                         }
                   10859:                     }
                   10860:                 }
                   10861:             }
1.987     raeburn  10862:         } else {
                   10863:             &logthis('Failed to parse '.$container.
                   10864:                      ' to modify references: '.$parse_result);
1.661     raeburn  10865:         }
                   10866:     }
1.1071    raeburn  10867:     if (wantarray) {
                   10868:         return ($output,$count,$codebasecount);
                   10869:     } else {
                   10870:         return $output;
                   10871:     }
1.661     raeburn  10872: }
                   10873: 
                   10874: sub check_for_existing {
                   10875:     my ($path,$fname,$element) = @_;
                   10876:     my ($state,$msg);
                   10877:     if (-d $path.'/'.$fname) {
                   10878:         $state = 'exists';
                   10879:         $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10880:     } elsif (-e $path.'/'.$fname) {
                   10881:         $state = 'exists';
                   10882:         $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
                   10883:     }
                   10884:     if ($state eq 'exists') {
                   10885:         $msg = '<span class="LC_error">'.$msg.'</span><br />';
                   10886:     }
                   10887:     return ($state,$msg);
                   10888: }
                   10889: 
                   10890: sub check_for_upload {
                   10891:     my ($path,$fname,$group,$element,$portfolio_root,$port_path,
                   10892:         $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985     raeburn  10893:     my $filesize = length($env{'form.'.$element});
                   10894:     if (!$filesize) {
                   10895:         my $msg = '<span class="LC_error">'.
                   10896:                   &mt('Unable to upload [_1]. (size = [_2] bytes)', 
                   10897:                       '<span class="LC_filename">'.$fname.'</span>',
                   10898:                       $filesize).'<br />'.
1.1007    raeburn  10899:                   &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985     raeburn  10900:                   '</span>';
                   10901:         return ('zero_bytes',$msg);
                   10902:     }
                   10903:     $filesize =  $filesize/1000; #express in k (1024?)
1.661     raeburn  10904:     my $getpropath = 1;
1.1021    raeburn  10905:     my ($dirlistref,$listerror) =
                   10906:          &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661     raeburn  10907:     my $found_file = 0;
                   10908:     my $locked_file = 0;
1.991     raeburn  10909:     my @lockers;
                   10910:     my $navmap;
                   10911:     if ($env{'request.course.id'}) {
                   10912:         $navmap = Apache::lonnavmaps::navmap->new();
                   10913:     }
1.1021    raeburn  10914:     if (ref($dirlistref) eq 'ARRAY') {
                   10915:         foreach my $line (@{$dirlistref}) {
                   10916:             my ($file_name,$rest)=split(/\&/,$line,2);
                   10917:             if ($file_name eq $fname){
                   10918:                 $file_name = $path.$file_name;
                   10919:                 if ($group ne '') {
                   10920:                     $file_name = $group.$file_name;
                   10921:                 }
                   10922:                 $found_file = 1;
                   10923:                 if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
                   10924:                     foreach my $lock (@lockers) {
                   10925:                         if (ref($lock) eq 'ARRAY') {
                   10926:                             my ($symb,$crsid) = @{$lock};
                   10927:                             if ($crsid eq $env{'request.course.id'}) {
                   10928:                                 if (ref($navmap)) {
                   10929:                                     my $res = $navmap->getBySymb($symb);
                   10930:                                     foreach my $part (@{$res->parts()}) { 
                   10931:                                         my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
                   10932:                                         unless (($slot_status == $res->RESERVED) ||
                   10933:                                                 ($slot_status == $res->RESERVED_LOCATION)) {
                   10934:                                             $locked_file = 1;
                   10935:                                         }
1.991     raeburn  10936:                                     }
1.1021    raeburn  10937:                                 } else {
                   10938:                                     $locked_file = 1;
1.991     raeburn  10939:                                 }
                   10940:                             } else {
                   10941:                                 $locked_file = 1;
                   10942:                             }
                   10943:                         }
1.1021    raeburn  10944:                    }
                   10945:                 } else {
                   10946:                     my @info = split(/\&/,$rest);
                   10947:                     my $currsize = $info[6]/1000;
                   10948:                     if ($currsize < $filesize) {
                   10949:                         my $extra = $filesize - $currsize;
                   10950:                         if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69  raeburn  10951:                             my $msg = '<p class="LC_warning">'.
1.1021    raeburn  10952:                                       &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  10953:                                           '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
                   10954:                                       '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
                   10955:                                                    $disk_quota,$current_disk_usage).'</p>';
1.1021    raeburn  10956:                             return ('will_exceed_quota',$msg);
                   10957:                         }
1.984     raeburn  10958:                     }
                   10959:                 }
1.661     raeburn  10960:             }
                   10961:         }
                   10962:     }
                   10963:     if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69  raeburn  10964:         my $msg = '<p class="LC_warning">'.
                   10965:                 &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
                   10966:                   '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661     raeburn  10967:         return ('will_exceed_quota',$msg);
                   10968:     } elsif ($found_file) {
                   10969:         if ($locked_file) {
1.1075.2.69  raeburn  10970:             my $msg = '<p class="LC_warning">';
1.661     raeburn  10971:             $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  10972:             $msg .= '</p>';
1.661     raeburn  10973:             $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
                   10974:             return ('file_locked',$msg);
                   10975:         } else {
1.1075.2.69  raeburn  10976:             my $msg = '<p class="LC_error">';
1.984     raeburn  10977:             $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  10978:             $msg .= '</p>';
1.984     raeburn  10979:             return ('existingfile',$msg);
1.661     raeburn  10980:         }
                   10981:     }
                   10982: }
                   10983: 
1.987     raeburn  10984: sub check_for_traversal {
                   10985:     my ($path,$url,$toplevel) = @_;
                   10986:     my @parts=split(/\//,$path);
                   10987:     my $cleanpath;
                   10988:     my $fullpath = $url;
                   10989:     for (my $i=0;$i<@parts;$i++) {
                   10990:         next if ($parts[$i] eq '.');
                   10991:         if ($parts[$i] eq '..') {
                   10992:             $fullpath =~ s{([^/]+/)$}{};
                   10993:         } else {
                   10994:             $fullpath .= $parts[$i].'/';
                   10995:         }
                   10996:     }
                   10997:     if ($fullpath =~ /^\Q$url\E(.*)$/) {
                   10998:         $cleanpath = $1;
                   10999:     } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
                   11000:         my $curr_toprel = $1;
                   11001:         my @parts = split(/\//,$curr_toprel);
                   11002:         my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
                   11003:         my @urlparts = split(/\//,$url_toprel);
                   11004:         my $doubledots;
                   11005:         my $startdiff = -1;
                   11006:         for (my $i=0; $i<@urlparts; $i++) {
                   11007:             if ($startdiff == -1) {
                   11008:                 unless ($urlparts[$i] eq $parts[$i]) {
                   11009:                     $startdiff = $i;
                   11010:                     $doubledots .= '../';
                   11011:                 }
                   11012:             } else {
                   11013:                 $doubledots .= '../';
                   11014:             }
                   11015:         }
                   11016:         if ($startdiff > -1) {
                   11017:             $cleanpath = $doubledots;
                   11018:             for (my $i=$startdiff; $i<@parts; $i++) {
                   11019:                 $cleanpath .= $parts[$i].'/';
                   11020:             }
                   11021:         }
                   11022:     }
                   11023:     $cleanpath =~ s{(/)$}{};
                   11024:     return $cleanpath;
                   11025: }
1.31      albertel 11026: 
1.1053    raeburn  11027: sub is_archive_file {
                   11028:     my ($mimetype) = @_;
                   11029:     if (($mimetype eq 'application/octet-stream') ||
                   11030:         ($mimetype eq 'application/x-stuffit') ||
                   11031:         ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
                   11032:         return 1;
                   11033:     }
                   11034:     return;
                   11035: }
                   11036: 
                   11037: sub decompress_form {
1.1065    raeburn  11038:     my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053    raeburn  11039:     my %lt = &Apache::lonlocal::texthash (
                   11040:         this => 'This file is an archive file.',
1.1067    raeburn  11041:         camt => 'This file is a Camtasia archive file.',
1.1065    raeburn  11042:         itsc => 'Its contents are as follows:',
1.1053    raeburn  11043:         youm => 'You may wish to extract its contents.',
                   11044:         extr => 'Extract contents',
1.1067    raeburn  11045:         auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
                   11046:         proa => 'Process automatically?',
1.1053    raeburn  11047:         yes  => 'Yes',
                   11048:         no   => 'No',
1.1067    raeburn  11049:         fold => 'Title for folder containing movie',
                   11050:         movi => 'Title for page containing embedded movie', 
1.1053    raeburn  11051:     );
1.1065    raeburn  11052:     my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067    raeburn  11053:     my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065    raeburn  11054:     my $info = &list_archive_contents($fileloc,\@paths);
                   11055:     if (@paths) {
                   11056:         foreach my $path (@paths) {
                   11057:             $path =~ s{^/}{};
1.1067    raeburn  11058:             if ($path =~ m{^([^/]+)/$}) {
                   11059:                 $topdir = $1;
                   11060:             }
1.1065    raeburn  11061:             if ($path =~ m{^([^/]+)/}) {
                   11062:                 $toplevel{$1} = $path;
                   11063:             } else {
                   11064:                 $toplevel{$path} = $path;
                   11065:             }
                   11066:         }
                   11067:     }
1.1067    raeburn  11068:     if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59  raeburn  11069:         my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067    raeburn  11070:                         "$topdir/media/",
                   11071:                         "$topdir/media/$topdir.mp4",
                   11072:                         "$topdir/media/FirstFrame.png",
                   11073:                         "$topdir/media/player.swf",
                   11074:                         "$topdir/media/swfobject.js",
                   11075:                         "$topdir/media/expressInstall.swf");
1.1075.2.81  raeburn  11076:         my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59  raeburn  11077:                          "$topdir/$topdir.mp4",
                   11078:                          "$topdir/$topdir\_config.xml",
                   11079:                          "$topdir/$topdir\_controller.swf",
                   11080:                          "$topdir/$topdir\_embed.css",
                   11081:                          "$topdir/$topdir\_First_Frame.png",
                   11082:                          "$topdir/$topdir\_player.html",
                   11083:                          "$topdir/$topdir\_Thumbnails.png",
                   11084:                          "$topdir/playerProductInstall.swf",
                   11085:                          "$topdir/scripts/",
                   11086:                          "$topdir/scripts/config_xml.js",
                   11087:                          "$topdir/scripts/handlebars.js",
                   11088:                          "$topdir/scripts/jquery-1.7.1.min.js",
                   11089:                          "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
                   11090:                          "$topdir/scripts/modernizr.js",
                   11091:                          "$topdir/scripts/player-min.js",
                   11092:                          "$topdir/scripts/swfobject.js",
                   11093:                          "$topdir/skins/",
                   11094:                          "$topdir/skins/configuration_express.xml",
                   11095:                          "$topdir/skins/express_show/",
                   11096:                          "$topdir/skins/express_show/player-min.css",
                   11097:                          "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81  raeburn  11098:         my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
                   11099:                          "$topdir/$topdir.mp4",
                   11100:                          "$topdir/$topdir\_config.xml",
                   11101:                          "$topdir/$topdir\_controller.swf",
                   11102:                          "$topdir/$topdir\_embed.css",
                   11103:                          "$topdir/$topdir\_First_Frame.png",
                   11104:                          "$topdir/$topdir\_player.html",
                   11105:                          "$topdir/$topdir\_Thumbnails.png",
                   11106:                          "$topdir/playerProductInstall.swf",
                   11107:                          "$topdir/scripts/",
                   11108:                          "$topdir/scripts/config_xml.js",
                   11109:                          "$topdir/scripts/techsmith-smart-player.min.js",
                   11110:                          "$topdir/skins/",
                   11111:                          "$topdir/skins/configuration_express.xml",
                   11112:                          "$topdir/skins/express_show/",
                   11113:                          "$topdir/skins/express_show/spritesheet.min.css",
                   11114:                          "$topdir/skins/express_show/spritesheet.png",
                   11115:                          "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59  raeburn  11116:         my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067    raeburn  11117:         if (@diffs == 0) {
1.1075.2.59  raeburn  11118:             $is_camtasia = 6;
                   11119:         } else {
1.1075.2.81  raeburn  11120:             @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59  raeburn  11121:             if (@diffs == 0) {
                   11122:                 $is_camtasia = 8;
1.1075.2.81  raeburn  11123:             } else {
                   11124:                 @diffs = &compare_arrays(\@paths,\@camtasia8_4);
                   11125:                 if (@diffs == 0) {
                   11126:                     $is_camtasia = 8;
                   11127:                 }
1.1075.2.59  raeburn  11128:             }
1.1067    raeburn  11129:         }
                   11130:     }
                   11131:     my $output;
                   11132:     if ($is_camtasia) {
                   11133:         $output = <<"ENDCAM";
                   11134: <script type="text/javascript" language="Javascript">
                   11135: // <![CDATA[
                   11136: 
                   11137: function camtasiaToggle() {
                   11138:     for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
                   11139:         if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59  raeburn  11140:             if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067    raeburn  11141:                 document.getElementById('camtasia_titles').style.display='block';
                   11142:             } else {
                   11143:                 document.getElementById('camtasia_titles').style.display='none';
                   11144:             }
                   11145:         }
                   11146:     }
                   11147:     return;
                   11148: }
                   11149: 
                   11150: // ]]>
                   11151: </script>
                   11152: <p>$lt{'camt'}</p>
                   11153: ENDCAM
1.1065    raeburn  11154:     } else {
1.1067    raeburn  11155:         $output = '<p>'.$lt{'this'};
                   11156:         if ($info eq '') {
                   11157:             $output .= ' '.$lt{'youm'}.'</p>'."\n";
                   11158:         } else {
                   11159:             $output .= ' '.$lt{'itsc'}.'</p>'."\n".
                   11160:                        '<div><pre>'.$info.'</pre></div>';
                   11161:         }
1.1065    raeburn  11162:     }
1.1067    raeburn  11163:     $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065    raeburn  11164:     my $duplicates;
                   11165:     my $num = 0;
                   11166:     if (ref($dirlist) eq 'ARRAY') {
                   11167:         foreach my $item (@{$dirlist}) {
                   11168:             if (ref($item) eq 'ARRAY') {
                   11169:                 if (exists($toplevel{$item->[0]})) {
                   11170:                     $duplicates .= 
                   11171:                         &start_data_table_row().
                   11172:                         '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11173:                         'value="0" checked="checked" />'.&mt('No').'</label>'.
                   11174:                         '&nbsp;<label><input type="radio" name="archive_overwrite_'.$num.'" '.
                   11175:                         'value="1" />'.&mt('Yes').'</label>'.
                   11176:                         '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
                   11177:                         '<td>'.$item->[0].'</td>';
                   11178:                     if ($item->[2]) {
                   11179:                         $duplicates .= '<td>'.&mt('Directory').'</td>';
                   11180:                     } else {
                   11181:                         $duplicates .= '<td>'.&mt('File').'</td>';
                   11182:                     }
                   11183:                     $duplicates .= '<td>'.$item->[3].'</td>'.
                   11184:                                    '<td>'.
                   11185:                                    &Apache::lonlocal::locallocaltime($item->[4]).
                   11186:                                    '</td>'.
                   11187:                                    &end_data_table_row();
                   11188:                     $num ++;
                   11189:                 }
                   11190:             }
                   11191:         }
                   11192:     }
                   11193:     my $itemcount;
                   11194:     if (@paths > 0) {
                   11195:         $itemcount = scalar(@paths);
                   11196:     } else {
                   11197:         $itemcount = 1;
                   11198:     }
1.1067    raeburn  11199:     if ($is_camtasia) {
                   11200:         $output .= $lt{'auto'}.'<br />'.
                   11201:                    '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59  raeburn  11202:                    '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067    raeburn  11203:                    $lt{'yes'}.'</label>&nbsp;<label>'.
                   11204:                    '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
                   11205:                    $lt{'no'}.'</label></span><br />'.
                   11206:                    '<div id="camtasia_titles" style="display:block">'.
                   11207:                    &Apache::lonhtmlcommon::start_pick_box().
                   11208:                    &Apache::lonhtmlcommon::row_title($lt{'fold'}).
                   11209:                    '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
                   11210:                    &Apache::lonhtmlcommon::row_closure().
                   11211:                    &Apache::lonhtmlcommon::row_title($lt{'movi'}).
                   11212:                    '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
                   11213:                    &Apache::lonhtmlcommon::row_closure(1).
                   11214:                    &Apache::lonhtmlcommon::end_pick_box().
                   11215:                    '</div>';
                   11216:     }
1.1065    raeburn  11217:     $output .= 
                   11218:         '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067    raeburn  11219:         '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
                   11220:         "\n";
1.1065    raeburn  11221:     if ($duplicates ne '') {
                   11222:         $output .= '<p><span class="LC_warning">'.
                   11223:                    &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.  
                   11224:                    &start_data_table().
                   11225:                    &start_data_table_header_row().
                   11226:                    '<th>'.&mt('Overwrite?').'</th>'.
                   11227:                    '<th>'.&mt('Name').'</th>'.
                   11228:                    '<th>'.&mt('Type').'</th>'.
                   11229:                    '<th>'.&mt('Size').'</th>'.
                   11230:                    '<th>'.&mt('Last modified').'</th>'.
                   11231:                    &end_data_table_header_row().
                   11232:                    $duplicates.
                   11233:                    &end_data_table().
                   11234:                    '</p>';
                   11235:     }
1.1067    raeburn  11236:     $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053    raeburn  11237:     if (ref($hiddenelements) eq 'HASH') {
                   11238:         foreach my $hidden (sort(keys(%{$hiddenelements}))) {
                   11239:             $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
                   11240:         }
                   11241:     }
                   11242:     $output .= <<"END";
1.1067    raeburn  11243: <br />
1.1053    raeburn  11244: <input type="submit" name="decompress" value="$lt{'extr'}" />
                   11245: </form>
                   11246: $noextract
                   11247: END
                   11248:     return $output;
                   11249: }
                   11250: 
1.1065    raeburn  11251: sub decompression_utility {
                   11252:     my ($program) = @_;
                   11253:     my @utilities = ('tar','gunzip','bunzip2','unzip'); 
                   11254:     my $location;
                   11255:     if (grep(/^\Q$program\E$/,@utilities)) { 
                   11256:         foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
                   11257:                          '/usr/sbin/') {
                   11258:             if (-x $dir.$program) {
                   11259:                 $location = $dir.$program;
                   11260:                 last;
                   11261:             }
                   11262:         }
                   11263:     }
                   11264:     return $location;
                   11265: }
                   11266: 
                   11267: sub list_archive_contents {
                   11268:     my ($file,$pathsref) = @_;
                   11269:     my (@cmd,$output);
                   11270:     my $needsregexp;
                   11271:     if ($file =~ /\.zip$/) {
                   11272:         @cmd = (&decompression_utility('unzip'),"-l");
                   11273:         $needsregexp = 1;
                   11274:     } elsif (($file =~ m/\.tar\.gz$/) ||
                   11275:              ($file =~ /\.tgz$/)) {
                   11276:         @cmd = (&decompression_utility('tar'),"-ztf");
                   11277:     } elsif ($file =~ /\.tar\.bz2$/) {
                   11278:         @cmd = (&decompression_utility('tar'),"-jtf");
                   11279:     } elsif ($file =~ m|\.tar$|) {
                   11280:         @cmd = (&decompression_utility('tar'),"-tf");
                   11281:     }
                   11282:     if (@cmd) {
                   11283:         undef($!);
                   11284:         undef($@);
                   11285:         if (open(my $fh,"-|", @cmd, $file)) {
                   11286:             while (my $line = <$fh>) {
                   11287:                 $output .= $line;
                   11288:                 chomp($line);
                   11289:                 my $item;
                   11290:                 if ($needsregexp) {
                   11291:                     ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/); 
                   11292:                 } else {
                   11293:                     $item = $line;
                   11294:                 }
                   11295:                 if ($item ne '') {
                   11296:                     unless (grep(/^\Q$item\E$/,@{$pathsref})) {
                   11297:                         push(@{$pathsref},$item);
                   11298:                     } 
                   11299:                 }
                   11300:             }
                   11301:             close($fh);
                   11302:         }
                   11303:     }
                   11304:     return $output;
                   11305: }
                   11306: 
1.1053    raeburn  11307: sub decompress_uploaded_file {
                   11308:     my ($file,$dir) = @_;
                   11309:     &Apache::lonnet::appenv({'cgi.file' => $file});
                   11310:     &Apache::lonnet::appenv({'cgi.dir' => $dir});
                   11311:     my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
                   11312:     my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
                   11313:     my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
                   11314:     &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
                   11315:     my $decompressed = $env{'cgi.decompressed'};
                   11316:     &Apache::lonnet::delenv('cgi.file');
                   11317:     &Apache::lonnet::delenv('cgi.dir');
                   11318:     &Apache::lonnet::delenv('cgi.decompressed');
                   11319:     return ($decompressed,$result);
                   11320: }
                   11321: 
1.1055    raeburn  11322: sub process_decompression {
                   11323:     my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
                   11324:     my ($dir,$error,$warning,$output);
1.1075.2.69  raeburn  11325:     if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34  raeburn  11326:         $error = &mt('Filename not a supported archive file type.').
                   11327:                  '<br />'.&mt('Filename should end with one of: [_1].',
1.1055    raeburn  11328:                               '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
                   11329:     } else {
                   11330:         my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11331:         if ($docuhome eq 'no_host') {
                   11332:             $error = &mt('Could not determine home server for course.');
                   11333:         } else {
                   11334:             my @ids=&Apache::lonnet::current_machine_ids();
                   11335:             my $currdir = "$dir_root/$destination";
                   11336:             if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11337:                 $dir = &LONCAPA::propath($docudom,$docuname).
                   11338:                        "$dir_root/$destination";
                   11339:             } else {
                   11340:                 $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
                   11341:                        "$dir_root/$docudom/$docuname/$destination";
                   11342:                 unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
                   11343:                     $error = &mt('Archive file not found.');
                   11344:                 }
                   11345:             }
1.1065    raeburn  11346:             my (@to_overwrite,@to_skip);
                   11347:             if ($env{'form.archive_overwrite_total'} > 0) {
                   11348:                 my $total = $env{'form.archive_overwrite_total'};
                   11349:                 for (my $i=0; $i<$total; $i++) {
                   11350:                     if ($env{'form.archive_overwrite_'.$i} == 1) {
                   11351:                         push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
                   11352:                     } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
                   11353:                         push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
                   11354:                     }
                   11355:                 }
                   11356:             }
                   11357:             my $numskip = scalar(@to_skip);
                   11358:             if (($numskip > 0) && 
                   11359:                 ($numskip == $env{'form.archive_itemcount'})) {
                   11360:                 $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');         
                   11361:             } elsif ($dir eq '') {
1.1055    raeburn  11362:                 $error = &mt('Directory containing archive file unavailable.');
                   11363:             } elsif (!$error) {
1.1065    raeburn  11364:                 my ($decompressed,$display);
                   11365:                 if ($numskip > 0) {
                   11366:                     my $tempdir = time.'_'.$$.int(rand(10000));
                   11367:                     mkdir("$dir/$tempdir",0755);
                   11368:                     system("mv $dir/$file $dir/$tempdir/$file");
                   11369:                     ($decompressed,$display) = 
                   11370:                         &decompress_uploaded_file($file,"$dir/$tempdir");
                   11371:                     foreach my $item (@to_skip) {
                   11372:                         if (($item ne '') && ($item !~ /\.\./)) {
                   11373:                             if (-f "$dir/$tempdir/$item") { 
                   11374:                                 unlink("$dir/$tempdir/$item");
                   11375:                             } elsif (-d "$dir/$tempdir/$item") {
                   11376:                                 system("rm -rf $dir/$tempdir/$item");
                   11377:                             }
                   11378:                         }
                   11379:                     }
                   11380:                     system("mv $dir/$tempdir/* $dir");
                   11381:                     rmdir("$dir/$tempdir");   
                   11382:                 } else {
                   11383:                     ($decompressed,$display) = 
                   11384:                         &decompress_uploaded_file($file,$dir);
                   11385:                 }
1.1055    raeburn  11386:                 if ($decompressed eq 'ok') {
1.1065    raeburn  11387:                     $output = '<p class="LC_info">'.
                   11388:                               &mt('Files extracted successfully from archive.').
                   11389:                               '</p>'."\n";
1.1055    raeburn  11390:                     my ($warning,$result,@contents);
                   11391:                     my ($newdirlistref,$newlisterror) =
                   11392:                         &Apache::lonnet::dirlist($currdir,$docudom,
                   11393:                                                  $docuname,1);
                   11394:                     my (%is_dir,%changes,@newitems);
                   11395:                     my $dirptr = 16384;
1.1065    raeburn  11396:                     if (ref($newdirlistref) eq 'ARRAY') {
1.1055    raeburn  11397:                         foreach my $dir_line (@{$newdirlistref}) {
                   11398:                             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065    raeburn  11399:                             unless (($item =~ /^\.+$/) || ($item eq $file) || 
                   11400:                                     ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055    raeburn  11401:                                 push(@newitems,$item);
                   11402:                                 if ($dirptr&$testdir) {
                   11403:                                     $is_dir{$item} = 1;
                   11404:                                 }
                   11405:                                 $changes{$item} = 1;
                   11406:                             }
                   11407:                         }
                   11408:                     }
                   11409:                     if (keys(%changes) > 0) {
                   11410:                         foreach my $item (sort(@newitems)) {
                   11411:                             if ($changes{$item}) {
                   11412:                                 push(@contents,$item);
                   11413:                             }
                   11414:                         }
                   11415:                     }
                   11416:                     if (@contents > 0) {
1.1067    raeburn  11417:                         my $wantform;
                   11418:                         unless ($env{'form.autoextract_camtasia'}) {
                   11419:                             $wantform = 1;
                   11420:                         }
1.1056    raeburn  11421:                         my (%children,%parent,%dirorder,%titles);
1.1055    raeburn  11422:                         my ($count,$datatable) = &get_extracted($docudom,$docuname,
                   11423:                                                                 $currdir,\%is_dir,
                   11424:                                                                 \%children,\%parent,
1.1056    raeburn  11425:                                                                 \@contents,\%dirorder,
                   11426:                                                                 \%titles,$wantform);
1.1055    raeburn  11427:                         if ($datatable ne '') {
                   11428:                             $output .= &archive_options_form('decompressed',$datatable,
                   11429:                                                              $count,$hiddenelem);
1.1065    raeburn  11430:                             my $startcount = 6;
1.1055    raeburn  11431:                             $output .= &archive_javascript($startcount,$count,
1.1056    raeburn  11432:                                                            \%titles,\%children);
1.1055    raeburn  11433:                         }
1.1067    raeburn  11434:                         if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59  raeburn  11435:                             my $version = $env{'form.autoextract_camtasia'};
1.1067    raeburn  11436:                             my %displayed;
                   11437:                             my $total = 1;
                   11438:                             $env{'form.archive_directory'} = [];
                   11439:                             foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
                   11440:                                 my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
                   11441:                                 $path =~ s{/$}{};
                   11442:                                 my $item;
                   11443:                                 if ($path ne '') {
                   11444:                                     $item = "$path/$titles{$i}";
                   11445:                                 } else {
                   11446:                                     $item = $titles{$i};
                   11447:                                 }
                   11448:                                 $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
                   11449:                                 if ($item eq $contents[0]) {
                   11450:                                     push(@{$env{'form.archive_directory'}},$i);
                   11451:                                     $env{'form.archive_'.$i} = 'display';
                   11452:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
                   11453:                                     $displayed{'folder'} = $i;
1.1075.2.59  raeburn  11454:                                 } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
                   11455:                                          (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067    raeburn  11456:                                     $env{'form.archive_'.$i} = 'display';
                   11457:                                     $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
                   11458:                                     $displayed{'web'} = $i;
                   11459:                                 } else {
1.1075.2.59  raeburn  11460:                                     if ((($item eq "$contents[0]/media") && ($version == 6)) ||
                   11461:                                         ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
                   11462:                                              ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067    raeburn  11463:                                         push(@{$env{'form.archive_directory'}},$i);
                   11464:                                     }
                   11465:                                     $env{'form.archive_'.$i} = 'dependency';
                   11466:                                 }
                   11467:                                 $total ++;
                   11468:                             }
                   11469:                             for (my $i=1; $i<$total; $i++) {
                   11470:                                 next if ($i == $displayed{'web'});
                   11471:                                 next if ($i == $displayed{'folder'});
                   11472:                                 $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
                   11473:                             }
                   11474:                             $env{'form.phase'} = 'decompress_cleanup';
                   11475:                             $env{'form.archivedelete'} = 1;
                   11476:                             $env{'form.archive_count'} = $total-1;
                   11477:                             $output .=
                   11478:                                 &process_extracted_files('coursedocs',$docudom,
                   11479:                                                          $docuname,$destination,
                   11480:                                                          $dir_root,$hiddenelem);
                   11481:                         }
1.1055    raeburn  11482:                     } else {
                   11483:                         $warning = &mt('No new items extracted from archive file.');
                   11484:                     }
                   11485:                 } else {
                   11486:                     $output = $display;
                   11487:                     $error = &mt('An error occurred during extraction from the archive file.');
                   11488:                 }
                   11489:             }
                   11490:         }
                   11491:     }
                   11492:     if ($error) {
                   11493:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   11494:                    $error.'</p>'."\n";
                   11495:     }
                   11496:     if ($warning) {
                   11497:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   11498:     }
                   11499:     return $output;
                   11500: }
                   11501: 
                   11502: sub get_extracted {
1.1056    raeburn  11503:     my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
                   11504:         $titles,$wantform) = @_;
1.1055    raeburn  11505:     my $count = 0;
                   11506:     my $depth = 0;
                   11507:     my $datatable;
1.1056    raeburn  11508:     my @hierarchy;
1.1055    raeburn  11509:     return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056    raeburn  11510:                    (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
                   11511:                    (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055    raeburn  11512:     foreach my $item (@{$contents}) {
                   11513:         $count ++;
1.1056    raeburn  11514:         @{$dirorder->{$count}} = @hierarchy;
                   11515:         $titles->{$count} = $item;
1.1055    raeburn  11516:         &archive_hierarchy($depth,$count,$parent,$children);
                   11517:         if ($wantform) {
                   11518:             $datatable .= &archive_row($is_dir->{$item},$item,
                   11519:                                        $currdir,$depth,$count);
                   11520:         }
                   11521:         if ($is_dir->{$item}) {
                   11522:             $depth ++;
1.1056    raeburn  11523:             push(@hierarchy,$count);
                   11524:             $parent->{$depth} = $count;
1.1055    raeburn  11525:             $datatable .=
                   11526:                 &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056    raeburn  11527:                                            \$depth,\$count,\@hierarchy,$dirorder,
                   11528:                                            $children,$parent,$titles,$wantform);
1.1055    raeburn  11529:             $depth --;
1.1056    raeburn  11530:             pop(@hierarchy);
1.1055    raeburn  11531:         }
                   11532:     }
                   11533:     return ($count,$datatable);
                   11534: }
                   11535: 
                   11536: sub recurse_extracted_archive {
1.1056    raeburn  11537:     my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
                   11538:         $children,$parent,$titles,$wantform) = @_;
1.1055    raeburn  11539:     my $result='';
1.1056    raeburn  11540:     unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
                   11541:             (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
                   11542:             (ref($dirorder) eq 'HASH')) {
1.1055    raeburn  11543:         return $result;
                   11544:     }
                   11545:     my $dirptr = 16384;
                   11546:     my ($newdirlistref,$newlisterror) =
                   11547:         &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
                   11548:     if (ref($newdirlistref) eq 'ARRAY') {
                   11549:         foreach my $dir_line (@{$newdirlistref}) {
                   11550:             my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
                   11551:             unless ($item =~ /^\.+$/) {
                   11552:                 $$count ++;
1.1056    raeburn  11553:                 @{$dirorder->{$$count}} = @{$hierarchy};
                   11554:                 $titles->{$$count} = $item;
1.1055    raeburn  11555:                 &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056    raeburn  11556: 
1.1055    raeburn  11557:                 my $is_dir;
                   11558:                 if ($dirptr&$testdir) {
                   11559:                     $is_dir = 1;
                   11560:                 }
                   11561:                 if ($wantform) {
                   11562:                     $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
                   11563:                 }
                   11564:                 if ($is_dir) {
                   11565:                     $$depth ++;
1.1056    raeburn  11566:                     push(@{$hierarchy},$$count);
                   11567:                     $parent->{$$depth} = $$count;
1.1055    raeburn  11568:                     $result .=
                   11569:                         &recurse_extracted_archive("$currdir/$item",$docudom,
                   11570:                                                    $docuname,$depth,$count,
1.1056    raeburn  11571:                                                    $hierarchy,$dirorder,$children,
                   11572:                                                    $parent,$titles,$wantform);
1.1055    raeburn  11573:                     $$depth --;
1.1056    raeburn  11574:                     pop(@{$hierarchy});
1.1055    raeburn  11575:                 }
                   11576:             }
                   11577:         }
                   11578:     }
                   11579:     return $result;
                   11580: }
                   11581: 
                   11582: sub archive_hierarchy {
                   11583:     my ($depth,$count,$parent,$children) =@_;
                   11584:     if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
                   11585:         if (exists($parent->{$depth})) {
                   11586:              $children->{$parent->{$depth}} .= $count.':';
                   11587:         }
                   11588:     }
                   11589:     return;
                   11590: }
                   11591: 
                   11592: sub archive_row {
                   11593:     my ($is_dir,$item,$currdir,$depth,$count) = @_;
                   11594:     my ($name) = ($item =~ m{([^/]+)$});
                   11595:     my %choices = &Apache::lonlocal::texthash (
1.1059    raeburn  11596:                                        'display'    => 'Add as file',
1.1055    raeburn  11597:                                        'dependency' => 'Include as dependency',
                   11598:                                        'discard'    => 'Discard',
                   11599:                                       );
                   11600:     if ($is_dir) {
1.1059    raeburn  11601:         $choices{'display'} = &mt('Add as folder'); 
1.1055    raeburn  11602:     }
1.1056    raeburn  11603:     my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
                   11604:     my $offset = 0;
1.1055    raeburn  11605:     foreach my $action ('display','dependency','discard') {
1.1056    raeburn  11606:         $offset ++;
1.1065    raeburn  11607:         if ($action ne 'display') {
                   11608:             $offset ++;
                   11609:         }  
1.1055    raeburn  11610:         $output .= '<td><span class="LC_nobreak">'.
                   11611:                    '<label><input type="radio" name="archive_'.$count.
                   11612:                    '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
                   11613:         my $text = $choices{$action};
                   11614:         if ($is_dir) {
                   11615:             $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
                   11616:             if ($action eq 'display') {
1.1059    raeburn  11617:                 $text = &mt('Add as folder');
1.1055    raeburn  11618:             }
1.1056    raeburn  11619:         } else {
                   11620:             $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
                   11621: 
                   11622:         }
                   11623:         $output .= ' />&nbsp;'.$choices{$action}.'</label></span>';
                   11624:         if ($action eq 'dependency') {
                   11625:             $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
                   11626:                        &mt('Used by:').'&nbsp;<select name="archive_dependent_on_'.$count.'" '.
                   11627:                        'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
                   11628:                        '<option value=""></option>'."\n".
                   11629:                        '</select>'."\n".
                   11630:                        '</div>';
1.1059    raeburn  11631:         } elsif ($action eq 'display') {
                   11632:             $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
                   11633:                        &mt('Title:').'&nbsp;<input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
                   11634:                        '</div>';
1.1055    raeburn  11635:         }
1.1056    raeburn  11636:         $output .= '</td>';
1.1055    raeburn  11637:     }
                   11638:     $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
                   11639:                &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.('&nbsp;' x 2);
                   11640:     for (my $i=0; $i<$depth; $i++) {
                   11641:         $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
                   11642:     }
                   11643:     if ($is_dir) {
                   11644:         $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />&nbsp;'."\n".
                   11645:                    '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
                   11646:     } else {
                   11647:         $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
                   11648:     }
                   11649:     $output .= '&nbsp;'.$name.'</td>'."\n".
                   11650:                &end_data_table_row();
                   11651:     return $output;
                   11652: }
                   11653: 
                   11654: sub archive_options_form {
1.1065    raeburn  11655:     my ($form,$display,$count,$hiddenelem) = @_;
                   11656:     my %lt = &Apache::lonlocal::texthash(
                   11657:                perm => 'Permanently remove archive file?',
                   11658:                hows => 'How should each extracted item be incorporated in the course?',
                   11659:                cont => 'Content actions for all',
                   11660:                addf => 'Add as folder/file',
                   11661:                incd => 'Include as dependency for a displayed file',
                   11662:                disc => 'Discard',
                   11663:                no   => 'No',
                   11664:                yes  => 'Yes',
                   11665:                save => 'Save',
                   11666:     );
                   11667:     my $output = <<"END";
                   11668: <form name="$form" method="post" action="">
                   11669: <p><span class="LC_nobreak">$lt{'perm'}&nbsp;
                   11670: <label>
                   11671:   <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
                   11672: </label>
                   11673: &nbsp;
                   11674: <label>
                   11675:   <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
                   11676: </span>
                   11677: </p>
                   11678: <input type="hidden" name="phase" value="decompress_cleanup" />
                   11679: <br />$lt{'hows'}
                   11680: <div class="LC_columnSection">
                   11681:   <fieldset>
                   11682:     <legend>$lt{'cont'}</legend>
                   11683:     <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" /> 
                   11684:     &nbsp;&nbsp;<input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
                   11685:     &nbsp;&nbsp;<input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
                   11686:   </fieldset>
                   11687: </div>
                   11688: END
                   11689:     return $output.
1.1055    raeburn  11690:            &start_data_table()."\n".
1.1065    raeburn  11691:            $display."\n".
1.1055    raeburn  11692:            &end_data_table()."\n".
                   11693:            '<input type="hidden" name="archive_count" value="'.$count.'" />'.
                   11694:            $hiddenelem.
1.1065    raeburn  11695:            '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055    raeburn  11696:            '</form>';
                   11697: }
                   11698: 
                   11699: sub archive_javascript {
1.1056    raeburn  11700:     my ($startcount,$numitems,$titles,$children) = @_;
                   11701:     return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059    raeburn  11702:     my $maintitle = $env{'form.comment'};
1.1055    raeburn  11703:     my $scripttag = <<START;
                   11704: <script type="text/javascript">
                   11705: // <![CDATA[
                   11706: 
                   11707: function checkAll(form,prefix) {
                   11708:     var idstr =  new RegExp("^archive_"+prefix+"_\\\\d+\$");
                   11709:     for (var i=0; i < form.elements.length; i++) {
                   11710:         var id = form.elements[i].id;
                   11711:         if ((id != '') && (id != undefined)) {
                   11712:             if (idstr.test(id)) {
                   11713:                 if (form.elements[i].type == 'radio') {
                   11714:                     form.elements[i].checked = true;
1.1056    raeburn  11715:                     var nostart = i-$startcount;
1.1059    raeburn  11716:                     var offset = nostart%7;
                   11717:                     var count = (nostart-offset)/7;    
1.1056    raeburn  11718:                     dependencyCheck(form,count,offset);
1.1055    raeburn  11719:                 }
                   11720:             }
                   11721:         }
                   11722:     }
                   11723: }
                   11724: 
                   11725: function propagateCheck(form,count) {
                   11726:     if (count > 0) {
1.1059    raeburn  11727:         var startelement = $startcount + ((count-1) * 7);
                   11728:         for (var j=1; j<6; j++) {
                   11729:             if ((j != 2) && (j != 4)) {
1.1056    raeburn  11730:                 var item = startelement + j; 
                   11731:                 if (form.elements[item].type == 'radio') {
                   11732:                     if (form.elements[item].checked) {
                   11733:                         containerCheck(form,count,j);
                   11734:                         break;
                   11735:                     }
1.1055    raeburn  11736:                 }
                   11737:             }
                   11738:         }
                   11739:     }
                   11740: }
                   11741: 
                   11742: numitems = $numitems
1.1056    raeburn  11743: var titles = new Array(numitems);
                   11744: var parents = new Array(numitems);
1.1055    raeburn  11745: for (var i=0; i<numitems; i++) {
1.1056    raeburn  11746:     parents[i] = new Array;
1.1055    raeburn  11747: }
1.1059    raeburn  11748: var maintitle = '$maintitle';
1.1055    raeburn  11749: 
                   11750: START
                   11751: 
1.1056    raeburn  11752:     foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
                   11753:         my @contents = split(/:/,$children->{$container});
1.1055    raeburn  11754:         for (my $i=0; $i<@contents; $i ++) {
                   11755:             $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
                   11756:         }
                   11757:     }
                   11758: 
1.1056    raeburn  11759:     foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
                   11760:         $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
                   11761:     }
                   11762: 
1.1055    raeburn  11763:     $scripttag .= <<END;
                   11764: 
                   11765: function containerCheck(form,count,offset) {
                   11766:     if (count > 0) {
1.1056    raeburn  11767:         dependencyCheck(form,count,offset);
1.1059    raeburn  11768:         var item = (offset+$startcount)+7*(count-1);
1.1055    raeburn  11769:         form.elements[item].checked = true;
                   11770:         if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11771:             if (parents[count].length > 0) {
                   11772:                 for (var j=0; j<parents[count].length; j++) {
1.1056    raeburn  11773:                     containerCheck(form,parents[count][j],offset);
                   11774:                 }
                   11775:             }
                   11776:         }
                   11777:     }
                   11778: }
                   11779: 
                   11780: function dependencyCheck(form,count,offset) {
                   11781:     if (count > 0) {
1.1059    raeburn  11782:         var chosen = (offset+$startcount)+7*(count-1);
                   11783:         var depitem = $startcount + ((count-1) * 7) + 4;
1.1056    raeburn  11784:         var currtype = form.elements[depitem].type;
                   11785:         if (form.elements[chosen].value == 'dependency') {
                   11786:             document.getElementById('arc_depon_'+count).style.display='block'; 
                   11787:             form.elements[depitem].options.length = 0;
                   11788:             form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11  raeburn  11789:             for (var i=1; i<=numitems; i++) {
                   11790:                 if (i == count) {
                   11791:                     continue;
                   11792:                 }
1.1059    raeburn  11793:                 var startelement = $startcount + (i-1) * 7;
                   11794:                 for (var j=1; j<6; j++) {
                   11795:                     if ((j != 2) && (j!= 4)) {
1.1056    raeburn  11796:                         var item = startelement + j;
                   11797:                         if (form.elements[item].type == 'radio') {
                   11798:                             if (form.elements[item].checked) {
                   11799:                                 if (form.elements[item].value == 'display') {
                   11800:                                     var n = form.elements[depitem].options.length;
                   11801:                                     form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
                   11802:                                 }
                   11803:                             }
                   11804:                         }
                   11805:                     }
                   11806:                 }
                   11807:             }
                   11808:         } else {
                   11809:             document.getElementById('arc_depon_'+count).style.display='none';
                   11810:             form.elements[depitem].options.length = 0;
                   11811:             form.elements[depitem].options[0] = new Option('Select','',true,true);
                   11812:         }
1.1059    raeburn  11813:         titleCheck(form,count,offset);
1.1056    raeburn  11814:     }
                   11815: }
                   11816: 
                   11817: function propagateSelect(form,count,offset) {
                   11818:     if (count > 0) {
1.1065    raeburn  11819:         var item = (1+offset+$startcount)+7*(count-1);
1.1056    raeburn  11820:         var picked = form.elements[item].options[form.elements[item].selectedIndex].value; 
                   11821:         if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11822:             if (parents[count].length > 0) {
                   11823:                 for (var j=0; j<parents[count].length; j++) {
                   11824:                     containerSelect(form,parents[count][j],offset,picked);
1.1055    raeburn  11825:                 }
                   11826:             }
                   11827:         }
                   11828:     }
                   11829: }
1.1056    raeburn  11830: 
                   11831: function containerSelect(form,count,offset,picked) {
                   11832:     if (count > 0) {
1.1065    raeburn  11833:         var item = (offset+$startcount)+7*(count-1);
1.1056    raeburn  11834:         if (form.elements[item].type == 'radio') {
                   11835:             if (form.elements[item].value == 'dependency') {
                   11836:                 if (form.elements[item+1].type == 'select-one') {
                   11837:                     for (var i=0; i<form.elements[item+1].options.length; i++) {
                   11838:                         if (form.elements[item+1].options[i].value == picked) {
                   11839:                             form.elements[item+1].selectedIndex = i;
                   11840:                             break;
                   11841:                         }
                   11842:                     }
                   11843:                 }
                   11844:                 if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
                   11845:                     if (parents[count].length > 0) {
                   11846:                         for (var j=0; j<parents[count].length; j++) {
                   11847:                             containerSelect(form,parents[count][j],offset,picked);
                   11848:                         }
                   11849:                     }
                   11850:                 }
                   11851:             }
                   11852:         }
                   11853:     }
                   11854: }
                   11855: 
1.1059    raeburn  11856: function titleCheck(form,count,offset) {
                   11857:     if (count > 0) {
                   11858:         var chosen = (offset+$startcount)+7*(count-1);
                   11859:         var depitem = $startcount + ((count-1) * 7) + 2;
                   11860:         var currtype = form.elements[depitem].type;
                   11861:         if (form.elements[chosen].value == 'display') {
                   11862:             document.getElementById('arc_title_'+count).style.display='block';
                   11863:             if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
                   11864:                 document.getElementById('archive_title_'+count).value=maintitle;
                   11865:             }
                   11866:         } else {
                   11867:             document.getElementById('arc_title_'+count).style.display='none';
                   11868:             if (currtype == 'text') { 
                   11869:                 document.getElementById('archive_title_'+count).value='';
                   11870:             }
                   11871:         }
                   11872:     }
                   11873:     return;
                   11874: }
                   11875: 
1.1055    raeburn  11876: // ]]>
                   11877: </script>
                   11878: END
                   11879:     return $scripttag;
                   11880: }
                   11881: 
                   11882: sub process_extracted_files {
1.1067    raeburn  11883:     my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055    raeburn  11884:     my $numitems = $env{'form.archive_count'};
                   11885:     return unless ($numitems);
                   11886:     my @ids=&Apache::lonnet::current_machine_ids();
                   11887:     my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067    raeburn  11888:         %folders,%containers,%mapinner,%prompttofetch);
1.1055    raeburn  11889:     my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
                   11890:     if (grep(/^\Q$docuhome\E$/,@ids)) {
                   11891:         $prefix = &LONCAPA::propath($docudom,$docuname);
                   11892:         $pathtocheck = "$dir_root/$destination";
                   11893:         $dir = $dir_root;
                   11894:         $ishome = 1;
                   11895:     } else {
                   11896:         $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
                   11897:         $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
                   11898:         $dir = "$dir_root/$docudom/$docuname";    
                   11899:     }
                   11900:     my $currdir = "$dir_root/$destination";
                   11901:     (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
                   11902:     if ($env{'form.folderpath'}) {
                   11903:         my @items = split('&',$env{'form.folderpath'});
                   11904:         $folders{'0'} = $items[-2];
1.1075.2.17  raeburn  11905:         if ($env{'form.folderpath'} =~ /\:1$/) {
                   11906:             $containers{'0'}='page';
                   11907:         } else {
                   11908:             $containers{'0'}='sequence';
                   11909:         }
1.1055    raeburn  11910:     }
                   11911:     my @archdirs = &get_env_multiple('form.archive_directory');
                   11912:     if ($numitems) {
                   11913:         for (my $i=1; $i<=$numitems; $i++) {
                   11914:             my $path = $env{'form.archive_content_'.$i};
                   11915:             if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
                   11916:                 my $item = $1;
                   11917:                 $toplevelitems{$item} = $i;
                   11918:                 if (grep(/^\Q$i\E$/,@archdirs)) {
                   11919:                     $is_dir{$item} = 1;
                   11920:                 }
                   11921:             }
                   11922:         }
                   11923:     }
1.1067    raeburn  11924:     my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055    raeburn  11925:     if (keys(%toplevelitems) > 0) {
                   11926:         my @contents = sort(keys(%toplevelitems));
1.1056    raeburn  11927:         (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
                   11928:                                            \%parent,\@contents,\%dirorder,\%titles);
1.1055    raeburn  11929:     }
1.1066    raeburn  11930:     my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055    raeburn  11931:     if ($numitems) {
                   11932:         for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11  raeburn  11933:             next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055    raeburn  11934:             my $path = $env{'form.archive_content_'.$i};
                   11935:             if ($path =~ /^\Q$pathtocheck\E/) {
                   11936:                 if ($env{'form.archive_'.$i} eq 'discard') {
                   11937:                     if ($prefix ne '' && $path ne '') {
                   11938:                         if (-e $prefix.$path) {
1.1066    raeburn  11939:                             if ((@archdirs > 0) && 
                   11940:                                 (grep(/^\Q$i\E$/,@archdirs))) {
                   11941:                                 $todeletedir{$prefix.$path} = 1;
                   11942:                             } else {
                   11943:                                 $todelete{$prefix.$path} = 1;
                   11944:                             }
1.1055    raeburn  11945:                         }
                   11946:                     }
                   11947:                 } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059    raeburn  11948:                     my ($docstitle,$title,$url,$outer);
1.1055    raeburn  11949:                     ($title) = ($path =~ m{/([^/]+)$});
1.1059    raeburn  11950:                     $docstitle = $env{'form.archive_title_'.$i};
                   11951:                     if ($docstitle eq '') {
                   11952:                         $docstitle = $title;
                   11953:                     }
1.1055    raeburn  11954:                     $outer = 0;
1.1056    raeburn  11955:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   11956:                         if (@{$dirorder{$i}} > 0) {
                   11957:                             foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055    raeburn  11958:                                 if ($env{'form.archive_'.$item} eq 'display') {
                   11959:                                     $outer = $item;
                   11960:                                     last;
                   11961:                                 }
                   11962:                             }
                   11963:                         }
                   11964:                     }
                   11965:                     my ($errtext,$fatal) = 
                   11966:                         &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
                   11967:                                                '/'.$folders{$outer}.'.'.
                   11968:                                                $containers{$outer});
                   11969:                     next if ($fatal);
                   11970:                     if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
                   11971:                         if ($context eq 'coursedocs') {
1.1056    raeburn  11972:                             $mapinner{$i} = time;
1.1055    raeburn  11973:                             $folders{$i} = 'default_'.$mapinner{$i};
                   11974:                             $containers{$i} = 'sequence';
                   11975:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11976:                                       $folders{$i}.'.'.$containers{$i};
                   11977:                             my $newidx = &LONCAPA::map::getresidx();
                   11978:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  11979:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  11980:                             push(@LONCAPA::map::order,$newidx);
                   11981:                             my ($outtext,$errtext) =
                   11982:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   11983:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  11984:                                                         '.'.$containers{$outer},1,1);
1.1056    raeburn  11985:                             $newseqid{$i} = $newidx;
1.1067    raeburn  11986:                             unless ($errtext) {
                   11987:                                 $result .=  '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
                   11988:                             }
1.1055    raeburn  11989:                         }
                   11990:                     } else {
                   11991:                         if ($context eq 'coursedocs') {
                   11992:                             my $newidx=&LONCAPA::map::getresidx();
                   11993:                             my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
                   11994:                                       $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
                   11995:                                       $title;
                   11996:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
                   11997:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
                   11998:                             }
                   11999:                             if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12000:                                 mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
                   12001:                             }
                   12002:                             if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
                   12003:                                 system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056    raeburn  12004:                                 $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067    raeburn  12005:                                 unless ($ishome) {
                   12006:                                     my $fetch = "$newdest{$i}/$title";
                   12007:                                     $fetch =~ s/^\Q$prefix$dir\E//;
                   12008:                                     $prompttofetch{$fetch} = 1;
                   12009:                                 }
1.1055    raeburn  12010:                             }
                   12011:                             $LONCAPA::map::resources[$newidx]=
1.1059    raeburn  12012:                                 $docstitle.':'.$url.':false:normal:res';
1.1055    raeburn  12013:                             push(@LONCAPA::map::order, $newidx);
                   12014:                             my ($outtext,$errtext)=
                   12015:                                 &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
                   12016:                                                         $docuname.'/'.$folders{$outer}.
1.1075.2.11  raeburn  12017:                                                         '.'.$containers{$outer},1,1);
1.1067    raeburn  12018:                             unless ($errtext) {
                   12019:                                 if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
                   12020:                                     $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
                   12021:                                 }
                   12022:                             }
1.1055    raeburn  12023:                         }
                   12024:                     }
1.1075.2.11  raeburn  12025:                 }
                   12026:             } else {
                   12027:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
                   12028:             }
                   12029:         }
                   12030:         for (my $i=1; $i<=$numitems; $i++) {
                   12031:             next unless ($env{'form.archive_'.$i} eq 'dependency');
                   12032:             my $path = $env{'form.archive_content_'.$i};
                   12033:             if ($path =~ /^\Q$pathtocheck\E/) {
                   12034:                 my ($title) = ($path =~ m{/([^/]+)$});
                   12035:                 $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
                   12036:                 if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
                   12037:                     if (ref($dirorder{$i}) eq 'ARRAY') {
                   12038:                         my ($itemidx,$fullpath,$relpath);
                   12039:                         if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
                   12040:                             my $container = $dirorder{$referrer{$i}}->[-1];
1.1056    raeburn  12041:                             for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11  raeburn  12042:                                 if ($dirorder{$i}->[$j] eq $container) {
                   12043:                                     $itemidx = $j;
1.1056    raeburn  12044:                                 }
                   12045:                             }
1.1075.2.11  raeburn  12046:                         }
                   12047:                         if ($itemidx eq '') {
                   12048:                             $itemidx =  0;
                   12049:                         }
                   12050:                         if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
                   12051:                             if ($mapinner{$referrer{$i}}) {
                   12052:                                 $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
                   12053:                                 for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12054:                                     if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12055:                                         unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12056:                                             $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12057:                                             $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12058:                                             if (!-e $fullpath) {
                   12059:                                                 mkdir($fullpath,0755);
1.1056    raeburn  12060:                                             }
                   12061:                                         }
1.1075.2.11  raeburn  12062:                                     } else {
                   12063:                                         last;
1.1056    raeburn  12064:                                     }
1.1075.2.11  raeburn  12065:                                 }
                   12066:                             }
                   12067:                         } elsif ($newdest{$referrer{$i}}) {
                   12068:                             $fullpath = $newdest{$referrer{$i}};
                   12069:                             for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
                   12070:                                 if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
                   12071:                                     $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
                   12072:                                     last;
                   12073:                                 } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
                   12074:                                     unless (defined($newseqid{$dirorder{$i}->[$j]})) {
                   12075:                                         $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12076:                                         $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
                   12077:                                         if (!-e $fullpath) {
                   12078:                                             mkdir($fullpath,0755);
1.1056    raeburn  12079:                                         }
                   12080:                                     }
1.1075.2.11  raeburn  12081:                                 } else {
                   12082:                                     last;
1.1056    raeburn  12083:                                 }
1.1075.2.11  raeburn  12084:                             }
                   12085:                         }
                   12086:                         if ($fullpath ne '') {
                   12087:                             if (-e "$prefix$path") {
                   12088:                                 system("mv $prefix$path $fullpath/$title");
                   12089:                             }
                   12090:                             if (-e "$fullpath/$title") {
                   12091:                                 my $showpath;
                   12092:                                 if ($relpath ne '') {
                   12093:                                     $showpath = "$relpath/$title";
                   12094:                                 } else {
                   12095:                                     $showpath = "/$title";
1.1056    raeburn  12096:                                 }
1.1075.2.11  raeburn  12097:                                 $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
                   12098:                             }
                   12099:                             unless ($ishome) {
                   12100:                                 my $fetch = "$fullpath/$title";
                   12101:                                 $fetch =~ s/^\Q$prefix$dir\E//;
                   12102:                                 $prompttofetch{$fetch} = 1;
1.1055    raeburn  12103:                             }
                   12104:                         }
                   12105:                     }
1.1075.2.11  raeburn  12106:                 } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
                   12107:                     $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
                   12108:                                     $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055    raeburn  12109:                 }
                   12110:             } else {
1.1075.2.11  raeburn  12111:                 $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055    raeburn  12112:             }
                   12113:         }
                   12114:         if (keys(%todelete)) {
                   12115:             foreach my $key (keys(%todelete)) {
                   12116:                 unlink($key);
1.1066    raeburn  12117:             }
                   12118:         }
                   12119:         if (keys(%todeletedir)) {
                   12120:             foreach my $key (keys(%todeletedir)) {
                   12121:                 rmdir($key);
                   12122:             }
                   12123:         }
                   12124:         foreach my $dir (sort(keys(%is_dir))) {
                   12125:             if (($pathtocheck ne '') && ($dir ne ''))  {
                   12126:                 &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055    raeburn  12127:             }
                   12128:         }
1.1067    raeburn  12129:         if ($result ne '') {
                   12130:             $output .= '<ul>'."\n".
                   12131:                        $result."\n".
                   12132:                        '</ul>';
                   12133:         }
                   12134:         unless ($ishome) {
                   12135:             my $replicationfail;
                   12136:             foreach my $item (keys(%prompttofetch)) {
                   12137:                 my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
                   12138:                 unless ($fetchresult eq 'ok') {
                   12139:                     $replicationfail .= '<li>'.$item.'</li>'."\n";
                   12140:                 }
                   12141:             }
                   12142:             if ($replicationfail) {
                   12143:                 $output .= '<p class="LC_error">'.
                   12144:                            &mt('Course home server failed to retrieve:').'<ul>'.
                   12145:                            $replicationfail.
                   12146:                            '</ul></p>';
                   12147:             }
                   12148:         }
1.1055    raeburn  12149:     } else {
                   12150:         $warning = &mt('No items found in archive.');
                   12151:     }
                   12152:     if ($error) {
                   12153:         $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
                   12154:                    $error.'</p>'."\n";
                   12155:     }
                   12156:     if ($warning) {
                   12157:         $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
                   12158:     }
                   12159:     return $output;
                   12160: }
                   12161: 
1.1066    raeburn  12162: sub cleanup_empty_dirs {
                   12163:     my ($path) = @_;
                   12164:     if (($path ne '') && (-d $path)) {
                   12165:         if (opendir(my $dirh,$path)) {
                   12166:             my @dircontents = grep(!/^\./,readdir($dirh));
                   12167:             my $numitems = 0;
                   12168:             foreach my $item (@dircontents) {
                   12169:                 if (-d "$path/$item") {
1.1075.2.28  raeburn  12170:                     &cleanup_empty_dirs("$path/$item");
1.1066    raeburn  12171:                     if (-e "$path/$item") {
                   12172:                         $numitems ++;
                   12173:                     }
                   12174:                 } else {
                   12175:                     $numitems ++;
                   12176:                 }
                   12177:             }
                   12178:             if ($numitems == 0) {
                   12179:                 rmdir($path);
                   12180:             }
                   12181:             closedir($dirh);
                   12182:         }
                   12183:     }
                   12184:     return;
                   12185: }
                   12186: 
1.41      ng       12187: =pod
1.45      matthew  12188: 
1.1075.2.56  raeburn  12189: =item * &get_folder_hierarchy()
1.1068    raeburn  12190: 
                   12191: Provides hierarchy of names of folders/sub-folders containing the current
                   12192: item,
                   12193: 
                   12194: Inputs: 3
                   12195:      - $navmap - navmaps object
                   12196: 
                   12197:      - $map - url for map (either the trigger itself, or map containing
                   12198:                            the resource, which is the trigger).
                   12199: 
                   12200:      - $showitem - 1 => show title for map itself; 0 => do not show.
                   12201: 
                   12202: Outputs: 1 @pathitems - array of folder/subfolder names.
                   12203: 
                   12204: =cut
                   12205: 
                   12206: sub get_folder_hierarchy {
                   12207:     my ($navmap,$map,$showitem) = @_;
                   12208:     my @pathitems;
                   12209:     if (ref($navmap)) {
                   12210:         my $mapres = $navmap->getResourceByUrl($map);
                   12211:         if (ref($mapres)) {
                   12212:             my $pcslist = $mapres->map_hierarchy();
                   12213:             if ($pcslist ne '') {
                   12214:                 my @pcs = split(/,/,$pcslist);
                   12215:                 foreach my $pc (@pcs) {
                   12216:                     if ($pc == 1) {
1.1075.2.38  raeburn  12217:                         push(@pathitems,&mt('Main Content'));
1.1068    raeburn  12218:                     } else {
                   12219:                         my $res = $navmap->getByMapPc($pc);
                   12220:                         if (ref($res)) {
                   12221:                             my $title = $res->compTitle();
                   12222:                             $title =~ s/\W+/_/g;
                   12223:                             if ($title ne '') {
                   12224:                                 push(@pathitems,$title);
                   12225:                             }
                   12226:                         }
                   12227:                     }
                   12228:                 }
                   12229:             }
1.1071    raeburn  12230:             if ($showitem) {
                   12231:                 if ($mapres->{ID} eq '0.0') {
1.1075.2.38  raeburn  12232:                     push(@pathitems,&mt('Main Content'));
1.1071    raeburn  12233:                 } else {
                   12234:                     my $maptitle = $mapres->compTitle();
                   12235:                     $maptitle =~ s/\W+/_/g;
                   12236:                     if ($maptitle ne '') {
                   12237:                         push(@pathitems,$maptitle);
                   12238:                     }
1.1068    raeburn  12239:                 }
                   12240:             }
                   12241:         }
                   12242:     }
                   12243:     return @pathitems;
                   12244: }
                   12245: 
                   12246: =pod
                   12247: 
1.1015    raeburn  12248: =item * &get_turnedin_filepath()
                   12249: 
                   12250: Determines path in a user's portfolio file for storage of files uploaded
                   12251: to a specific essayresponse or dropbox item.
                   12252: 
                   12253: Inputs: 3 required + 1 optional.
                   12254: $symb is symb for resource, $uname and $udom are for current user (required).
                   12255: $caller is optional (can be "submission", if routine is called when storing
                   12256: an upoaded file when "Submit Answer" button was pressed).
                   12257: 
                   12258: Returns array containing $path and $multiresp. 
                   12259: $path is path in portfolio.  $multiresp is 1 if this resource contains more
                   12260: than one file upload item.  Callers of routine should append partid as a 
                   12261: subdirectory to $path in cases where $multiresp is 1.
                   12262: 
                   12263: Called by: homework/essayresponse.pm and homework/structuretags.pm
                   12264: 
                   12265: =cut
                   12266: 
                   12267: sub get_turnedin_filepath {
                   12268:     my ($symb,$uname,$udom,$caller) = @_;
                   12269:     my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
                   12270:     my $turnindir;
                   12271:     my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
                   12272:     $turnindir = $userhash{'turnindir'};
                   12273:     my ($path,$multiresp);
                   12274:     if ($turnindir eq '') {
                   12275:         if ($caller eq 'submission') {
                   12276:             $turnindir = &mt('turned in');
                   12277:             $turnindir =~ s/\W+/_/g;
                   12278:             my %newhash = (
                   12279:                             'turnindir' => $turnindir,
                   12280:                           );
                   12281:             &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
                   12282:         }
                   12283:     }
                   12284:     if ($turnindir ne '') {
                   12285:         $path = '/'.$turnindir.'/';
                   12286:         my ($multipart,$turnin,@pathitems);
                   12287:         my $navmap = Apache::lonnavmaps::navmap->new();
                   12288:         if (defined($navmap)) {
                   12289:             my $mapres = $navmap->getResourceByUrl($map);
                   12290:             if (ref($mapres)) {
                   12291:                 my $pcslist = $mapres->map_hierarchy();
                   12292:                 if ($pcslist ne '') {
                   12293:                     foreach my $pc (split(/,/,$pcslist)) {
                   12294:                         my $res = $navmap->getByMapPc($pc);
                   12295:                         if (ref($res)) {
                   12296:                             my $title = $res->compTitle();
                   12297:                             $title =~ s/\W+/_/g;
                   12298:                             if ($title ne '') {
1.1075.2.48  raeburn  12299:                                 if (($pc > 1) && (length($title) > 12)) {
                   12300:                                     $title = substr($title,0,12);
                   12301:                                 }
1.1015    raeburn  12302:                                 push(@pathitems,$title);
                   12303:                             }
                   12304:                         }
                   12305:                     }
                   12306:                 }
                   12307:                 my $maptitle = $mapres->compTitle();
                   12308:                 $maptitle =~ s/\W+/_/g;
                   12309:                 if ($maptitle ne '') {
1.1075.2.48  raeburn  12310:                     if (length($maptitle) > 12) {
                   12311:                         $maptitle = substr($maptitle,0,12);
                   12312:                     }
1.1015    raeburn  12313:                     push(@pathitems,$maptitle);
                   12314:                 }
                   12315:                 unless ($env{'request.state'} eq 'construct') {
                   12316:                     my $res = $navmap->getBySymb($symb);
                   12317:                     if (ref($res)) {
                   12318:                         my $partlist = $res->parts();
                   12319:                         my $totaluploads = 0;
                   12320:                         if (ref($partlist) eq 'ARRAY') {
                   12321:                             foreach my $part (@{$partlist}) {
                   12322:                                 my @types = $res->responseType($part);
                   12323:                                 my @ids = $res->responseIds($part);
                   12324:                                 for (my $i=0; $i < scalar(@ids); $i++) {
                   12325:                                     if ($types[$i] eq 'essay') {
                   12326:                                         my $partid = $part.'_'.$ids[$i];
                   12327:                                         if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
                   12328:                                             $totaluploads ++;
                   12329:                                         }
                   12330:                                     }
                   12331:                                 }
                   12332:                             }
                   12333:                             if ($totaluploads > 1) {
                   12334:                                 $multiresp = 1;
                   12335:                             }
                   12336:                         }
                   12337:                     }
                   12338:                 }
                   12339:             } else {
                   12340:                 return;
                   12341:             }
                   12342:         } else {
                   12343:             return;
                   12344:         }
                   12345:         my $restitle=&Apache::lonnet::gettitle($symb);
                   12346:         $restitle =~ s/\W+/_/g;
                   12347:         if ($restitle eq '') {
                   12348:             $restitle = ($resurl =~ m{/[^/]+$});
                   12349:             if ($restitle eq '') {
                   12350:                 $restitle = time;
                   12351:             }
                   12352:         }
1.1075.2.48  raeburn  12353:         if (length($restitle) > 12) {
                   12354:             $restitle = substr($restitle,0,12);
                   12355:         }
1.1015    raeburn  12356:         push(@pathitems,$restitle);
                   12357:         $path .= join('/',@pathitems);
                   12358:     }
                   12359:     return ($path,$multiresp);
                   12360: }
                   12361: 
                   12362: =pod
                   12363: 
1.464     albertel 12364: =back
1.41      ng       12365: 
1.112     bowersj2 12366: =head1 CSV Upload/Handling functions
1.38      albertel 12367: 
1.41      ng       12368: =over 4
                   12369: 
1.648     raeburn  12370: =item * &upfile_store($r)
1.41      ng       12371: 
                   12372: Store uploaded file, $r should be the HTTP Request object,
1.258     albertel 12373: needs $env{'form.upfile'}
1.41      ng       12374: returns $datatoken to be put into hidden field
                   12375: 
                   12376: =cut
1.31      albertel 12377: 
                   12378: sub upfile_store {
                   12379:     my $r=shift;
1.258     albertel 12380:     $env{'form.upfile'}=~s/\r/\n/gs;
                   12381:     $env{'form.upfile'}=~s/\f/\n/gs;
                   12382:     $env{'form.upfile'}=~s/\n+/\n/gs;
                   12383:     $env{'form.upfile'}=~s/\n+$//gs;
1.31      albertel 12384: 
1.258     albertel 12385:     my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
                   12386: 	'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31      albertel 12387:     {
1.158     raeburn  12388:         my $datafile = $r->dir_config('lonDaemons').
                   12389:                            '/tmp/'.$datatoken.'.tmp';
                   12390:         if ( open(my $fh,">$datafile") ) {
1.258     albertel 12391:             print $fh $env{'form.upfile'};
1.158     raeburn  12392:             close($fh);
                   12393:         }
1.31      albertel 12394:     }
                   12395:     return $datatoken;
                   12396: }
                   12397: 
1.56      matthew  12398: =pod
                   12399: 
1.648     raeburn  12400: =item * &load_tmp_file($r)
1.41      ng       12401: 
                   12402: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258     albertel 12403: needs $env{'form.datatoken'},
                   12404: sets $env{'form.upfile'} to the contents of the file
1.41      ng       12405: 
                   12406: =cut
1.31      albertel 12407: 
                   12408: sub load_tmp_file {
                   12409:     my $r=shift;
                   12410:     my @studentdata=();
                   12411:     {
1.158     raeburn  12412:         my $studentfile = $r->dir_config('lonDaemons').
1.258     albertel 12413:                               '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158     raeburn  12414:         if ( open(my $fh,"<$studentfile") ) {
                   12415:             @studentdata=<$fh>;
                   12416:             close($fh);
                   12417:         }
1.31      albertel 12418:     }
1.258     albertel 12419:     $env{'form.upfile'}=join('',@studentdata);
1.31      albertel 12420: }
                   12421: 
1.56      matthew  12422: =pod
                   12423: 
1.648     raeburn  12424: =item * &upfile_record_sep()
1.41      ng       12425: 
                   12426: Separate uploaded file into records
                   12427: returns array of records,
1.258     albertel 12428: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41      ng       12429: 
                   12430: =cut
1.31      albertel 12431: 
                   12432: sub upfile_record_sep {
1.258     albertel 12433:     if ($env{'form.upfiletype'} eq 'xml') {
1.31      albertel 12434:     } else {
1.248     albertel 12435: 	my @records;
1.258     albertel 12436: 	foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248     albertel 12437: 	    if ($line=~/^\s*$/) { next; }
                   12438: 	    push(@records,$line);
                   12439: 	}
                   12440: 	return @records;
1.31      albertel 12441:     }
                   12442: }
                   12443: 
1.56      matthew  12444: =pod
                   12445: 
1.648     raeburn  12446: =item * &record_sep($record)
1.41      ng       12447: 
1.258     albertel 12448: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41      ng       12449: 
                   12450: =cut
                   12451: 
1.263     www      12452: sub takeleft {
                   12453:     my $index=shift;
                   12454:     return substr('0000'.$index,-4,4);
                   12455: }
                   12456: 
1.31      albertel 12457: sub record_sep {
                   12458:     my $record=shift;
                   12459:     my %components=();
1.258     albertel 12460:     if ($env{'form.upfiletype'} eq 'xml') {
                   12461:     } elsif ($env{'form.upfiletype'} eq 'space') {
1.31      albertel 12462:         my $i=0;
1.356     albertel 12463:         foreach my $field (split(/\s+/,$record)) {
1.31      albertel 12464:             $field=~s/^(\"|\')//;
                   12465:             $field=~s/(\"|\')$//;
1.263     www      12466:             $components{&takeleft($i)}=$field;
1.31      albertel 12467:             $i++;
                   12468:         }
1.258     albertel 12469:     } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31      albertel 12470:         my $i=0;
1.356     albertel 12471:         foreach my $field (split(/\t/,$record)) {
1.31      albertel 12472:             $field=~s/^(\"|\')//;
                   12473:             $field=~s/(\"|\')$//;
1.263     www      12474:             $components{&takeleft($i)}=$field;
1.31      albertel 12475:             $i++;
                   12476:         }
                   12477:     } else {
1.561     www      12478:         my $separator=',';
1.480     banghart 12479:         if ($env{'form.upfiletype'} eq 'semisv') {
1.561     www      12480:             $separator=';';
1.480     banghart 12481:         }
1.31      albertel 12482:         my $i=0;
1.561     www      12483: # the character we are looking for to indicate the end of a quote or a record 
                   12484:         my $looking_for=$separator;
                   12485: # do not add the characters to the fields
                   12486:         my $ignore=0;
                   12487: # we just encountered a separator (or the beginning of the record)
                   12488:         my $just_found_separator=1;
                   12489: # store the field we are working on here
                   12490:         my $field='';
                   12491: # work our way through all characters in record
                   12492:         foreach my $character ($record=~/(.)/g) {
                   12493:             if ($character eq $looking_for) {
                   12494:                if ($character ne $separator) {
                   12495: # Found the end of a quote, again looking for separator
                   12496:                   $looking_for=$separator;
                   12497:                   $ignore=1;
                   12498:                } else {
                   12499: # Found a separator, store away what we got
                   12500:                   $components{&takeleft($i)}=$field;
                   12501: 	          $i++;
                   12502:                   $just_found_separator=1;
                   12503:                   $ignore=0;
                   12504:                   $field='';
                   12505:                }
                   12506:                next;
                   12507:             }
                   12508: # single or double quotation marks after a separator indicate beginning of a quote
                   12509: # we are now looking for the end of the quote and need to ignore separators
                   12510:             if ((($character eq '"') || ($character eq "'")) && ($just_found_separator))  {
                   12511:                $looking_for=$character;
                   12512:                next;
                   12513:             }
                   12514: # ignore would be true after we reached the end of a quote
                   12515:             if ($ignore) { next; }
                   12516:             if (($just_found_separator) && ($character=~/\s/)) { next; }
                   12517:             $field.=$character;
                   12518:             $just_found_separator=0; 
1.31      albertel 12519:         }
1.561     www      12520: # catch the very last entry, since we never encountered the separator
                   12521:         $components{&takeleft($i)}=$field;
1.31      albertel 12522:     }
                   12523:     return %components;
                   12524: }
                   12525: 
1.144     matthew  12526: ######################################################
                   12527: ######################################################
                   12528: 
1.56      matthew  12529: =pod
                   12530: 
1.648     raeburn  12531: =item * &upfile_select_html()
1.41      ng       12532: 
1.144     matthew  12533: Return HTML code to select a file from the users machine and specify 
                   12534: the file type.
1.41      ng       12535: 
                   12536: =cut
                   12537: 
1.144     matthew  12538: ######################################################
                   12539: ######################################################
1.31      albertel 12540: sub upfile_select_html {
1.144     matthew  12541:     my %Types = (
                   12542:                  csv   => &mt('CSV (comma separated values, spreadsheet)'),
1.480     banghart 12543:                  semisv => &mt('Semicolon separated values'),
1.144     matthew  12544:                  space => &mt('Space separated'),
                   12545:                  tab   => &mt('Tabulator separated'),
                   12546: #                 xml   => &mt('HTML/XML'),
                   12547:                  );
                   12548:     my $Str = '<input type="file" name="upfile" size="50" />'.
1.727     riegler  12549:         '<br />'.&mt('Type').': <select name="upfiletype">';
1.144     matthew  12550:     foreach my $type (sort(keys(%Types))) {
                   12551:         $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
                   12552:     }
                   12553:     $Str .= "</select>\n";
                   12554:     return $Str;
1.31      albertel 12555: }
                   12556: 
1.301     albertel 12557: sub get_samples {
                   12558:     my ($records,$toget) = @_;
                   12559:     my @samples=({});
                   12560:     my $got=0;
                   12561:     foreach my $rec (@$records) {
                   12562: 	my %temp = &record_sep($rec);
                   12563: 	if (! grep(/\S/, values(%temp))) { next; }
                   12564: 	if (%temp) {
                   12565: 	    $samples[$got]=\%temp;
                   12566: 	    $got++;
                   12567: 	    if ($got == $toget) { last; }
                   12568: 	}
                   12569:     }
                   12570:     return \@samples;
                   12571: }
                   12572: 
1.144     matthew  12573: ######################################################
                   12574: ######################################################
                   12575: 
1.56      matthew  12576: =pod
                   12577: 
1.648     raeburn  12578: =item * &csv_print_samples($r,$records)
1.41      ng       12579: 
                   12580: Prints a table of sample values from each column uploaded $r is an
                   12581: Apache Request ref, $records is an arrayref from
                   12582: &Apache::loncommon::upfile_record_sep
                   12583: 
                   12584: =cut
                   12585: 
1.144     matthew  12586: ######################################################
                   12587: ######################################################
1.31      albertel 12588: sub csv_print_samples {
                   12589:     my ($r,$records) = @_;
1.662     bisitz   12590:     my $samples = &get_samples($records,5);
1.301     albertel 12591: 
1.594     raeburn  12592:     $r->print(&mt('Samples').'<br />'.&start_data_table().
                   12593:               &start_data_table_header_row());
1.356     albertel 12594:     foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) { 
1.845     bisitz   12595:         $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594     raeburn  12596:     $r->print(&end_data_table_header_row());
1.301     albertel 12597:     foreach my $hash (@$samples) {
1.594     raeburn  12598: 	$r->print(&start_data_table_row());
1.356     albertel 12599: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31      albertel 12600: 	    $r->print('<td>');
1.356     albertel 12601: 	    if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31      albertel 12602: 	    $r->print('</td>');
                   12603: 	}
1.594     raeburn  12604: 	$r->print(&end_data_table_row());
1.31      albertel 12605:     }
1.594     raeburn  12606:     $r->print(&end_data_table().'<br />'."\n");
1.31      albertel 12607: }
                   12608: 
1.144     matthew  12609: ######################################################
                   12610: ######################################################
                   12611: 
1.56      matthew  12612: =pod
                   12613: 
1.648     raeburn  12614: =item * &csv_print_select_table($r,$records,$d)
1.41      ng       12615: 
                   12616: Prints a table to create associations between values and table columns.
1.144     matthew  12617: 
1.41      ng       12618: $r is an Apache Request ref,
                   12619: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174     matthew  12620: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41      ng       12621: 
                   12622: =cut
                   12623: 
1.144     matthew  12624: ######################################################
                   12625: ######################################################
1.31      albertel 12626: sub csv_print_select_table {
                   12627:     my ($r,$records,$d) = @_;
1.301     albertel 12628:     my $i=0;
                   12629:     my $samples = &get_samples($records,1);
1.144     matthew  12630:     $r->print(&mt('Associate columns with student attributes.')."\n".
1.594     raeburn  12631: 	      &start_data_table().&start_data_table_header_row().
1.144     matthew  12632:               '<th>'.&mt('Attribute').'</th>'.
1.594     raeburn  12633:               '<th>'.&mt('Column').'</th>'.
                   12634:               &end_data_table_header_row()."\n");
1.356     albertel 12635:     foreach my $array_ref (@$d) {
                   12636: 	my ($value,$display,$defaultcol)=@{ $array_ref };
1.729     raeburn  12637: 	$r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31      albertel 12638: 
1.875     bisitz   12639: 	$r->print('<td><select name="f'.$i.'"'.
1.32      matthew  12640: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.31      albertel 12641: 	$r->print('<option value="none"></option>');
1.356     albertel 12642: 	foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
                   12643: 	    $r->print('<option value="'.$sample.'"'.
                   12644:                       ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662     bisitz   12645:                       '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31      albertel 12646: 	}
1.594     raeburn  12647: 	$r->print('</select></td>'.&end_data_table_row()."\n");
1.31      albertel 12648: 	$i++;
                   12649:     }
1.594     raeburn  12650:     $r->print(&end_data_table());
1.31      albertel 12651:     $i--;
                   12652:     return $i;
                   12653: }
1.56      matthew  12654: 
1.144     matthew  12655: ######################################################
                   12656: ######################################################
                   12657: 
1.56      matthew  12658: =pod
1.31      albertel 12659: 
1.648     raeburn  12660: =item * &csv_samples_select_table($r,$records,$d)
1.41      ng       12661: 
                   12662: Prints a table of sample values from the upload and can make associate samples to internal names.
                   12663: 
                   12664: $r is an Apache Request ref,
                   12665: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
                   12666: $d is an array of 2 element arrays (internal name, displayed name)
                   12667: 
                   12668: =cut
                   12669: 
1.144     matthew  12670: ######################################################
                   12671: ######################################################
1.31      albertel 12672: sub csv_samples_select_table {
                   12673:     my ($r,$records,$d) = @_;
                   12674:     my $i=0;
1.144     matthew  12675:     #
1.662     bisitz   12676:     my $max_samples = 5;
                   12677:     my $samples = &get_samples($records,$max_samples);
1.594     raeburn  12678:     $r->print(&start_data_table().
                   12679:               &start_data_table_header_row().'<th>'.
                   12680:               &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
                   12681:               &end_data_table_header_row());
1.301     albertel 12682: 
                   12683:     foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594     raeburn  12684: 	$r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32      matthew  12685: 		  ' onchange="javascript:flip(this.form,'.$i.');">');
1.301     albertel 12686: 	foreach my $option (@$d) {
                   12687: 	    my ($value,$display,$defaultcol)=@{ $option };
1.174     matthew  12688: 	    $r->print('<option value="'.$value.'"'.
1.253     albertel 12689:                       ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174     matthew  12690:                       $display.'</option>');
1.31      albertel 12691: 	}
                   12692: 	$r->print('</select></td><td>');
1.662     bisitz   12693: 	foreach my $line (0..($max_samples-1)) {
1.301     albertel 12694: 	    if (defined($samples->[$line]{$key})) { 
                   12695: 		$r->print($samples->[$line]{$key}."<br />\n"); 
                   12696: 	    }
                   12697: 	}
1.594     raeburn  12698: 	$r->print('</td>'.&end_data_table_row());
1.31      albertel 12699: 	$i++;
                   12700:     }
1.594     raeburn  12701:     $r->print(&end_data_table());
1.31      albertel 12702:     $i--;
                   12703:     return($i);
1.115     matthew  12704: }
                   12705: 
1.144     matthew  12706: ######################################################
                   12707: ######################################################
                   12708: 
1.115     matthew  12709: =pod
                   12710: 
1.648     raeburn  12711: =item * &clean_excel_name($name)
1.115     matthew  12712: 
                   12713: Returns a replacement for $name which does not contain any illegal characters.
                   12714: 
                   12715: =cut
                   12716: 
1.144     matthew  12717: ######################################################
                   12718: ######################################################
1.115     matthew  12719: sub clean_excel_name {
                   12720:     my ($name) = @_;
                   12721:     $name =~ s/[:\*\?\/\\]//g;
                   12722:     if (length($name) > 31) {
                   12723:         $name = substr($name,0,31);
                   12724:     }
                   12725:     return $name;
1.25      albertel 12726: }
1.84      albertel 12727: 
1.85      albertel 12728: =pod
                   12729: 
1.648     raeburn  12730: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85      albertel 12731: 
                   12732: Returns either 1 or undef
                   12733: 
                   12734: 1 if the part is to be hidden, undef if it is to be shown
                   12735: 
                   12736: Arguments are:
                   12737: 
                   12738: $id the id of the part to be checked
                   12739: $symb, optional the symb of the resource to check
                   12740: $udom, optional the domain of the user to check for
                   12741: $uname, optional the username of the user to check for
                   12742: 
                   12743: =cut
1.84      albertel 12744: 
                   12745: sub check_if_partid_hidden {
                   12746:     my ($id,$symb,$udom,$uname) = @_;
1.133     albertel 12747:     my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84      albertel 12748: 					 $symb,$udom,$uname);
1.141     albertel 12749:     my $truth=1;
                   12750:     #if the string starts with !, then the list is the list to show not hide
                   12751:     if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84      albertel 12752:     my @hiddenlist=split(/,/,$hiddenparts);
                   12753:     foreach my $checkid (@hiddenlist) {
1.141     albertel 12754: 	if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84      albertel 12755:     }
1.141     albertel 12756:     return !$truth;
1.84      albertel 12757: }
1.127     matthew  12758: 
1.138     matthew  12759: 
                   12760: ############################################################
                   12761: ############################################################
                   12762: 
                   12763: =pod
                   12764: 
1.157     matthew  12765: =back 
                   12766: 
1.138     matthew  12767: =head1 cgi-bin script and graphing routines
                   12768: 
1.157     matthew  12769: =over 4
                   12770: 
1.648     raeburn  12771: =item * &get_cgi_id()
1.138     matthew  12772: 
                   12773: Inputs: none
                   12774: 
                   12775: Returns an id which can be used to pass environment variables
                   12776: to various cgi-bin scripts.  These environment variables will
                   12777: be removed from the users environment after a given time by
                   12778: the routine &Apache::lonnet::transfer_profile_to_env.
                   12779: 
                   12780: =cut
                   12781: 
                   12782: ############################################################
                   12783: ############################################################
1.152     albertel 12784: my $uniq=0;
1.136     matthew  12785: sub get_cgi_id {
1.154     albertel 12786:     $uniq=($uniq+1)%100000;
1.280     albertel 12787:     return (time.'_'.$$.'_'.$uniq);
1.136     matthew  12788: }
                   12789: 
1.127     matthew  12790: ############################################################
                   12791: ############################################################
                   12792: 
                   12793: =pod
                   12794: 
1.648     raeburn  12795: =item * &DrawBarGraph()
1.127     matthew  12796: 
1.138     matthew  12797: Facilitates the plotting of data in a (stacked) bar graph.
                   12798: Puts plot definition data into the users environment in order for 
                   12799: graph.png to plot it.  Returns an <img> tag for the plot.
                   12800: The bars on the plot are labeled '1','2',...,'n'.
                   12801: 
                   12802: Inputs:
                   12803: 
                   12804: =over 4
                   12805: 
                   12806: =item $Title: string, the title of the plot
                   12807: 
                   12808: =item $xlabel: string, text describing the X-axis of the plot
                   12809: 
                   12810: =item $ylabel: string, text describing the Y-axis of the plot
                   12811: 
                   12812: =item $Max: scalar, the maximum Y value to use in the plot
                   12813: If $Max is < any data point, the graph will not be rendered.
                   12814: 
1.140     matthew  12815: =item $colors: array ref holding the colors to be used for the data sets when
1.138     matthew  12816: they are plotted.  If undefined, default values will be used.
                   12817: 
1.178     matthew  12818: =item $labels: array ref holding the labels to use on the x-axis for the bars.
                   12819: 
1.138     matthew  12820: =item @Values: An array of array references.  Each array reference holds data
                   12821: to be plotted in a stacked bar chart.
                   12822: 
1.239     matthew  12823: =item If the final element of @Values is a hash reference the key/value
                   12824: pairs will be added to the graph definition.
                   12825: 
1.138     matthew  12826: =back
                   12827: 
                   12828: Returns:
                   12829: 
                   12830: An <img> tag which references graph.png and the appropriate identifying
                   12831: information for the plot.
                   12832: 
1.127     matthew  12833: =cut
                   12834: 
                   12835: ############################################################
                   12836: ############################################################
1.134     matthew  12837: sub DrawBarGraph {
1.178     matthew  12838:     my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134     matthew  12839:     #
                   12840:     if (! defined($colors)) {
                   12841:         $colors = ['#33ff00', 
                   12842:                   '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
                   12843:                   '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
                   12844:                   ]; 
                   12845:     }
1.228     matthew  12846:     my $extra_settings = {};
                   12847:     if (ref($Values[-1]) eq 'HASH') {
                   12848:         $extra_settings = pop(@Values);
                   12849:     }
1.127     matthew  12850:     #
1.136     matthew  12851:     my $identifier = &get_cgi_id();
                   12852:     my $id = 'cgi.'.$identifier;        
1.129     matthew  12853:     if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127     matthew  12854:         return '';
                   12855:     }
1.225     matthew  12856:     #
                   12857:     my @Labels;
                   12858:     if (defined($labels)) {
                   12859:         @Labels = @$labels;
                   12860:     } else {
                   12861:         for (my $i=0;$i<@{$Values[0]};$i++) {
                   12862:             push (@Labels,$i+1);
                   12863:         }
                   12864:     }
                   12865:     #
1.129     matthew  12866:     my $NumBars = scalar(@{$Values[0]});
1.225     matthew  12867:     if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129     matthew  12868:     my %ValuesHash;
                   12869:     my $NumSets=1;
                   12870:     foreach my $array (@Values) {
                   12871:         next if (! ref($array));
1.136     matthew  12872:         $ValuesHash{$id.'.data.'.$NumSets++} = 
1.132     matthew  12873:             join(',',@$array);
1.129     matthew  12874:     }
1.127     matthew  12875:     #
1.136     matthew  12876:     my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225     matthew  12877:     if ($NumBars < 3) {
                   12878:         $width = 120+$NumBars*32;
1.220     matthew  12879:         $xskip = 1;
1.225     matthew  12880:         $bar_width = 30;
                   12881:     } elsif ($NumBars < 5) {
                   12882:         $width = 120+$NumBars*20;
                   12883:         $xskip = 1;
                   12884:         $bar_width = 20;
1.220     matthew  12885:     } elsif ($NumBars < 10) {
1.136     matthew  12886:         $width = 120+$NumBars*15;
                   12887:         $xskip = 1;
                   12888:         $bar_width = 15;
                   12889:     } elsif ($NumBars <= 25) {
                   12890:         $width = 120+$NumBars*11;
                   12891:         $xskip = 5;
                   12892:         $bar_width = 8;
                   12893:     } elsif ($NumBars <= 50) {
                   12894:         $width = 120+$NumBars*8;
                   12895:         $xskip = 5;
                   12896:         $bar_width = 4;
                   12897:     } else {
                   12898:         $width = 120+$NumBars*8;
                   12899:         $xskip = 5;
                   12900:         $bar_width = 4;
                   12901:     }
                   12902:     #
1.137     matthew  12903:     $Max = 1 if ($Max < 1);
                   12904:     if ( int($Max) < $Max ) {
                   12905:         $Max++;
                   12906:         $Max = int($Max);
                   12907:     }
1.127     matthew  12908:     $Title  = '' if (! defined($Title));
                   12909:     $xlabel = '' if (! defined($xlabel));
                   12910:     $ylabel = '' if (! defined($ylabel));
1.369     www      12911:     $ValuesHash{$id.'.title'}    = &escape($Title);
                   12912:     $ValuesHash{$id.'.xlabel'}   = &escape($xlabel);
                   12913:     $ValuesHash{$id.'.ylabel'}   = &escape($ylabel);
1.137     matthew  12914:     $ValuesHash{$id.'.y_max_value'} = $Max;
1.136     matthew  12915:     $ValuesHash{$id.'.NumBars'}  = $NumBars;
                   12916:     $ValuesHash{$id.'.NumSets'}  = $NumSets;
                   12917:     $ValuesHash{$id.'.PlotType'} = 'bar';
                   12918:     $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   12919:     $ValuesHash{$id.'.height'}   = $height;
                   12920:     $ValuesHash{$id.'.width'}    = $width;
                   12921:     $ValuesHash{$id.'.xskip'}    = $xskip;
                   12922:     $ValuesHash{$id.'.bar_width'} = $bar_width;
                   12923:     $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127     matthew  12924:     #
1.228     matthew  12925:     # Deal with other parameters
                   12926:     while (my ($key,$value) = each(%$extra_settings)) {
                   12927:         $ValuesHash{$id.'.'.$key} = $value;
                   12928:     }
                   12929:     #
1.646     raeburn  12930:     &Apache::lonnet::appenv(\%ValuesHash);
1.137     matthew  12931:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   12932: }
                   12933: 
                   12934: ############################################################
                   12935: ############################################################
                   12936: 
                   12937: =pod
                   12938: 
1.648     raeburn  12939: =item * &DrawXYGraph()
1.137     matthew  12940: 
1.138     matthew  12941: Facilitates the plotting of data in an XY graph.
                   12942: Puts plot definition data into the users environment in order for 
                   12943: graph.png to plot it.  Returns an <img> tag for the plot.
                   12944: 
                   12945: Inputs:
                   12946: 
                   12947: =over 4
                   12948: 
                   12949: =item $Title: string, the title of the plot
                   12950: 
                   12951: =item $xlabel: string, text describing the X-axis of the plot
                   12952: 
                   12953: =item $ylabel: string, text describing the Y-axis of the plot
                   12954: 
                   12955: =item $Max: scalar, the maximum Y value to use in the plot
                   12956: If $Max is < any data point, the graph will not be rendered.
                   12957: 
                   12958: =item $colors: Array ref containing the hex color codes for the data to be 
                   12959: plotted in.  If undefined, default values will be used.
                   12960: 
                   12961: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   12962: 
                   12963: =item $Ydata: Array ref containing Array refs.  
1.185     www      12964: Each of the contained arrays will be plotted as a separate curve.
1.138     matthew  12965: 
                   12966: =item %Values: hash indicating or overriding any default values which are 
                   12967: passed to graph.png.  
                   12968: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   12969: 
                   12970: =back
                   12971: 
                   12972: Returns:
                   12973: 
                   12974: An <img> tag which references graph.png and the appropriate identifying
                   12975: information for the plot.
                   12976: 
1.137     matthew  12977: =cut
                   12978: 
                   12979: ############################################################
                   12980: ############################################################
                   12981: sub DrawXYGraph {
                   12982:     my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
                   12983:     #
                   12984:     # Create the identifier for the graph
                   12985:     my $identifier = &get_cgi_id();
                   12986:     my $id = 'cgi.'.$identifier;
                   12987:     #
                   12988:     $Title  = '' if (! defined($Title));
                   12989:     $xlabel = '' if (! defined($xlabel));
                   12990:     $ylabel = '' if (! defined($ylabel));
                   12991:     my %ValuesHash = 
                   12992:         (
1.369     www      12993:          $id.'.title'  => &escape($Title),
                   12994:          $id.'.xlabel' => &escape($xlabel),
                   12995:          $id.'.ylabel' => &escape($ylabel),
1.137     matthew  12996:          $id.'.y_max_value'=> $Max,
                   12997:          $id.'.labels'     => join(',',@$Xlabels),
                   12998:          $id.'.PlotType'   => 'XY',
                   12999:          );
                   13000:     #
                   13001:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13002:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13003:     }
                   13004:     #
                   13005:     if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
                   13006:         return '';
                   13007:     }
                   13008:     my $NumSets=1;
1.138     matthew  13009:     foreach my $array (@{$Ydata}){
1.137     matthew  13010:         next if (! ref($array));
                   13011:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
                   13012:     }
1.138     matthew  13013:     $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137     matthew  13014:     #
                   13015:     # Deal with other parameters
                   13016:     while (my ($key,$value) = each(%Values)) {
                   13017:         $ValuesHash{$id.'.'.$key} = $value;
1.127     matthew  13018:     }
                   13019:     #
1.646     raeburn  13020:     &Apache::lonnet::appenv(\%ValuesHash);
1.136     matthew  13021:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
                   13022: }
                   13023: 
                   13024: ############################################################
                   13025: ############################################################
                   13026: 
                   13027: =pod
                   13028: 
1.648     raeburn  13029: =item * &DrawXYYGraph()
1.138     matthew  13030: 
                   13031: Facilitates the plotting of data in an XY graph with two Y axes.
                   13032: Puts plot definition data into the users environment in order for 
                   13033: graph.png to plot it.  Returns an <img> tag for the plot.
                   13034: 
                   13035: Inputs:
                   13036: 
                   13037: =over 4
                   13038: 
                   13039: =item $Title: string, the title of the plot
                   13040: 
                   13041: =item $xlabel: string, text describing the X-axis of the plot
                   13042: 
                   13043: =item $ylabel: string, text describing the Y-axis of the plot
                   13044: 
                   13045: =item $colors: Array ref containing the hex color codes for the data to be 
                   13046: plotted in.  If undefined, default values will be used.
                   13047: 
                   13048: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
                   13049: 
                   13050: =item $Ydata1: The first data set
                   13051: 
                   13052: =item $Min1: The minimum value of the left Y-axis
                   13053: 
                   13054: =item $Max1: The maximum value of the left Y-axis
                   13055: 
                   13056: =item $Ydata2: The second data set
                   13057: 
                   13058: =item $Min2: The minimum value of the right Y-axis
                   13059: 
                   13060: =item $Max2: The maximum value of the left Y-axis
                   13061: 
                   13062: =item %Values: hash indicating or overriding any default values which are 
                   13063: passed to graph.png.  
                   13064: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
                   13065: 
                   13066: =back
                   13067: 
                   13068: Returns:
                   13069: 
                   13070: An <img> tag which references graph.png and the appropriate identifying
                   13071: information for the plot.
1.136     matthew  13072: 
                   13073: =cut
                   13074: 
                   13075: ############################################################
                   13076: ############################################################
1.137     matthew  13077: sub DrawXYYGraph {
                   13078:     my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
                   13079:                                         $Ydata2,$Min2,$Max2,%Values)=@_;
1.136     matthew  13080:     #
                   13081:     # Create the identifier for the graph
                   13082:     my $identifier = &get_cgi_id();
                   13083:     my $id = 'cgi.'.$identifier;
                   13084:     #
                   13085:     $Title  = '' if (! defined($Title));
                   13086:     $xlabel = '' if (! defined($xlabel));
                   13087:     $ylabel = '' if (! defined($ylabel));
                   13088:     my %ValuesHash = 
                   13089:         (
1.369     www      13090:          $id.'.title'  => &escape($Title),
                   13091:          $id.'.xlabel' => &escape($xlabel),
                   13092:          $id.'.ylabel' => &escape($ylabel),
1.136     matthew  13093:          $id.'.labels' => join(',',@$Xlabels),
                   13094:          $id.'.PlotType' => 'XY',
                   13095:          $id.'.NumSets' => 2,
1.137     matthew  13096:          $id.'.two_axes' => 1,
                   13097:          $id.'.y1_max_value' => $Max1,
                   13098:          $id.'.y1_min_value' => $Min1,
                   13099:          $id.'.y2_max_value' => $Max2,
                   13100:          $id.'.y2_min_value' => $Min2,
1.136     matthew  13101:          );
                   13102:     #
1.137     matthew  13103:     if (defined($colors) && ref($colors) eq 'ARRAY') {
                   13104:         $ValuesHash{$id.'.Colors'}   = join(',',@{$colors});
                   13105:     }
                   13106:     #
                   13107:     if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
                   13108:         ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136     matthew  13109:         return '';
                   13110:     }
                   13111:     my $NumSets=1;
1.137     matthew  13112:     foreach my $array ($Ydata1,$Ydata2){
1.136     matthew  13113:         next if (! ref($array));
                   13114:         $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137     matthew  13115:     }
                   13116:     #
                   13117:     # Deal with other parameters
                   13118:     while (my ($key,$value) = each(%Values)) {
                   13119:         $ValuesHash{$id.'.'.$key} = $value;
1.136     matthew  13120:     }
                   13121:     #
1.646     raeburn  13122:     &Apache::lonnet::appenv(\%ValuesHash);
1.130     albertel 13123:     return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139     matthew  13124: }
                   13125: 
                   13126: ############################################################
                   13127: ############################################################
                   13128: 
                   13129: =pod
                   13130: 
1.157     matthew  13131: =back 
                   13132: 
1.139     matthew  13133: =head1 Statistics helper routines?  
                   13134: 
                   13135: Bad place for them but what the hell.
                   13136: 
1.157     matthew  13137: =over 4
                   13138: 
1.648     raeburn  13139: =item * &chartlink()
1.139     matthew  13140: 
                   13141: Returns a link to the chart for a specific student.  
                   13142: 
                   13143: Inputs:
                   13144: 
                   13145: =over 4
                   13146: 
                   13147: =item $linktext: The text of the link
                   13148: 
                   13149: =item $sname: The students username
                   13150: 
                   13151: =item $sdomain: The students domain
                   13152: 
                   13153: =back
                   13154: 
1.157     matthew  13155: =back
                   13156: 
1.139     matthew  13157: =cut
                   13158: 
                   13159: ############################################################
                   13160: ############################################################
                   13161: sub chartlink {
                   13162:     my ($linktext, $sname, $sdomain) = @_;
                   13163:     my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369     www      13164:         '&amp;SelectedStudent='.&escape($sname.':'.$sdomain).
1.219     albertel 13165:         '&amp;chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139     matthew  13166:        '">'.$linktext.'</a>';
1.153     matthew  13167: }
                   13168: 
                   13169: #######################################################
                   13170: #######################################################
                   13171: 
                   13172: =pod
                   13173: 
                   13174: =head1 Course Environment Routines
1.157     matthew  13175: 
                   13176: =over 4
1.153     matthew  13177: 
1.648     raeburn  13178: =item * &restore_course_settings()
1.153     matthew  13179: 
1.648     raeburn  13180: =item * &store_course_settings()
1.153     matthew  13181: 
                   13182: Restores/Store indicated form parameters from the course environment.
                   13183: Will not overwrite existing values of the form parameters.
                   13184: 
                   13185: Inputs: 
                   13186: a scalar describing the data (e.g. 'chart', 'problem_analysis')
                   13187: 
                   13188: a hash ref describing the data to be stored.  For example:
                   13189:    
                   13190: %Save_Parameters = ('Status' => 'scalar',
                   13191:     'chartoutputmode' => 'scalar',
                   13192:     'chartoutputdata' => 'scalar',
                   13193:     'Section' => 'array',
1.373     raeburn  13194:     'Group' => 'array',
1.153     matthew  13195:     'StudentData' => 'array',
                   13196:     'Maps' => 'array');
                   13197: 
                   13198: Returns: both routines return nothing
                   13199: 
1.631     raeburn  13200: =back
                   13201: 
1.153     matthew  13202: =cut
                   13203: 
                   13204: #######################################################
                   13205: #######################################################
                   13206: sub store_course_settings {
1.496     albertel 13207:     return &store_settings($env{'request.course.id'},@_);
                   13208: }
                   13209: 
                   13210: sub store_settings {
1.153     matthew  13211:     # save to the environment
                   13212:     # appenv the same items, just to be safe
1.300     albertel 13213:     my $udom  = $env{'user.domain'};
                   13214:     my $uname = $env{'user.name'};
1.496     albertel 13215:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13216:     my %SaveHash;
                   13217:     my %AppHash;
                   13218:     while (my ($setting,$type) = each(%$Settings)) {
1.496     albertel 13219:         my $basename = join('.','internal',$context,$prefix,$setting);
1.300     albertel 13220:         my $envname = 'environment.'.$basename;
1.258     albertel 13221:         if (exists($env{'form.'.$setting})) {
1.153     matthew  13222:             # Save this value away
                   13223:             if ($type eq 'scalar' &&
1.258     albertel 13224:                 (! exists($env{$envname}) || 
                   13225:                  $env{$envname} ne $env{'form.'.$setting})) {
                   13226:                 $SaveHash{$basename} = $env{'form.'.$setting};
                   13227:                 $AppHash{$envname}   = $env{'form.'.$setting};
1.153     matthew  13228:             } elsif ($type eq 'array') {
                   13229:                 my $stored_form;
1.258     albertel 13230:                 if (ref($env{'form.'.$setting})) {
1.153     matthew  13231:                     $stored_form = join(',',
                   13232:                                         map {
1.369     www      13233:                                             &escape($_);
1.258     albertel 13234:                                         } sort(@{$env{'form.'.$setting}}));
1.153     matthew  13235:                 } else {
                   13236:                     $stored_form = 
1.369     www      13237:                         &escape($env{'form.'.$setting});
1.153     matthew  13238:                 }
                   13239:                 # Determine if the array contents are the same.
1.258     albertel 13240:                 if ($stored_form ne $env{$envname}) {
1.153     matthew  13241:                     $SaveHash{$basename} = $stored_form;
                   13242:                     $AppHash{$envname}   = $stored_form;
                   13243:                 }
                   13244:             }
                   13245:         }
                   13246:     }
                   13247:     my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300     albertel 13248:                                           $udom,$uname);
1.153     matthew  13249:     if ($put_result !~ /^(ok|delayed)/) {
                   13250:         &Apache::lonnet::logthis('unable to save form parameters, '.
                   13251:                                  'got error:'.$put_result);
                   13252:     }
                   13253:     # Make sure these settings stick around in this session, too
1.646     raeburn  13254:     &Apache::lonnet::appenv(\%AppHash);
1.153     matthew  13255:     return;
                   13256: }
                   13257: 
                   13258: sub restore_course_settings {
1.499     albertel 13259:     return &restore_settings($env{'request.course.id'},@_);
1.496     albertel 13260: }
                   13261: 
                   13262: sub restore_settings {
                   13263:     my ($context,$prefix,$Settings) = @_;
1.153     matthew  13264:     while (my ($setting,$type) = each(%$Settings)) {
1.258     albertel 13265:         next if (exists($env{'form.'.$setting}));
1.496     albertel 13266:         my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153     matthew  13267:             '.'.$setting;
1.258     albertel 13268:         if (exists($env{$envname})) {
1.153     matthew  13269:             if ($type eq 'scalar') {
1.258     albertel 13270:                 $env{'form.'.$setting} = $env{$envname};
1.153     matthew  13271:             } elsif ($type eq 'array') {
1.258     albertel 13272:                 $env{'form.'.$setting} = [ 
1.153     matthew  13273:                                            map { 
1.369     www      13274:                                                &unescape($_); 
1.258     albertel 13275:                                            } split(',',$env{$envname})
1.153     matthew  13276:                                            ];
                   13277:             }
                   13278:         }
                   13279:     }
1.127     matthew  13280: }
                   13281: 
1.618     raeburn  13282: #######################################################
                   13283: #######################################################
                   13284: 
                   13285: =pod
                   13286: 
                   13287: =head1 Domain E-mail Routines  
                   13288: 
                   13289: =over 4
                   13290: 
1.648     raeburn  13291: =item * &build_recipient_list()
1.618     raeburn  13292: 
1.1075.2.44  raeburn  13293: Build recipient lists for following types of e-mail:
1.766     raeburn  13294: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44  raeburn  13295: (d) Help requests, (e) Course requests needing approval, (f) loncapa
                   13296: module change checking, student/employee ID conflict checks, as
                   13297: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
                   13298: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618     raeburn  13299: 
                   13300: Inputs:
1.1075.2.44  raeburn  13301: defmail (scalar - email address of default recipient),
                   13302: mailing type (scalar: errormail, packagesmail, helpdeskmail,
                   13303: requestsmail, updatesmail, or idconflictsmail).
                   13304: 
1.619     raeburn  13305: defdom (domain for which to retrieve configuration settings),
1.1075.2.44  raeburn  13306: 
                   13307: origmail (scalar - email address of recipient from loncapa.conf,
                   13308: i.e., predates configuration by DC via domainprefs.pm
1.618     raeburn  13309: 
1.655     raeburn  13310: Returns: comma separated list of addresses to which to send e-mail.
                   13311: 
                   13312: =back
1.618     raeburn  13313: 
                   13314: =cut
                   13315: 
                   13316: ############################################################
                   13317: ############################################################
                   13318: sub build_recipient_list {
1.619     raeburn  13319:     my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618     raeburn  13320:     my @recipients;
                   13321:     my $otheremails;
                   13322:     my %domconfig =
                   13323:          &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
                   13324:     if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766     raeburn  13325:         if (exists($domconfig{'contacts'}{$mailing})) {
                   13326:             if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
                   13327:                 my @contacts = ('adminemail','supportemail');
                   13328:                 foreach my $item (@contacts) {
                   13329:                     if ($domconfig{'contacts'}{$mailing}{$item}) {
                   13330:                         my $addr = $domconfig{'contacts'}{$item}; 
                   13331:                         if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13332:                             push(@recipients,$addr);
                   13333:                         }
1.619     raeburn  13334:                     }
1.766     raeburn  13335:                     $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618     raeburn  13336:                 }
                   13337:             }
1.766     raeburn  13338:         } elsif ($origmail ne '') {
                   13339:             push(@recipients,$origmail);
1.618     raeburn  13340:         }
1.619     raeburn  13341:     } elsif ($origmail ne '') {
                   13342:         push(@recipients,$origmail);
1.618     raeburn  13343:     }
1.688     raeburn  13344:     if (defined($defmail)) {
                   13345:         if ($defmail ne '') {
                   13346:             push(@recipients,$defmail);
                   13347:         }
1.618     raeburn  13348:     }
                   13349:     if ($otheremails) {
1.619     raeburn  13350:         my @others;
                   13351:         if ($otheremails =~ /,/) {
                   13352:             @others = split(/,/,$otheremails);
1.618     raeburn  13353:         } else {
1.619     raeburn  13354:             push(@others,$otheremails);
                   13355:         }
                   13356:         foreach my $addr (@others) {
                   13357:             if (!grep(/^\Q$addr\E$/,@recipients)) {
                   13358:                 push(@recipients,$addr);
                   13359:             }
1.618     raeburn  13360:         }
                   13361:     }
1.619     raeburn  13362:     my $recipientlist = join(',',@recipients); 
1.618     raeburn  13363:     return $recipientlist;
                   13364: }
                   13365: 
1.127     matthew  13366: ############################################################
                   13367: ############################################################
1.154     albertel 13368: 
1.655     raeburn  13369: =pod
                   13370: 
                   13371: =head1 Course Catalog Routines
                   13372: 
                   13373: =over 4
                   13374: 
                   13375: =item * &gather_categories()
                   13376: 
                   13377: Converts category definitions - keys of categories hash stored in  
                   13378: coursecategories in configuration.db on the primary library server in a 
                   13379: domain - to an array.  Also generates javascript and idx hash used to 
                   13380: generate Domain Coordinator interface for editing Course Categories.
                   13381: 
                   13382: Inputs:
1.663     raeburn  13383: 
1.655     raeburn  13384: categories (reference to hash of category definitions).
1.663     raeburn  13385: 
1.655     raeburn  13386: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13387:       categories and subcategories).
1.663     raeburn  13388: 
1.655     raeburn  13389: idx (reference to hash of counters used in Domain Coordinator interface for 
                   13390:       editing Course Categories).
1.663     raeburn  13391: 
1.655     raeburn  13392: jsarray (reference to array of categories used to create Javascript arrays for
                   13393:          Domain Coordinator interface for editing Course Categories).
                   13394: 
                   13395: Returns: nothing
                   13396: 
                   13397: Side effects: populates cats, idx and jsarray. 
                   13398: 
                   13399: =cut
                   13400: 
                   13401: sub gather_categories {
                   13402:     my ($categories,$cats,$idx,$jsarray) = @_;
                   13403:     my %counters;
                   13404:     my $num = 0;
                   13405:     foreach my $item (keys(%{$categories})) {
                   13406:         my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
                   13407:         if ($container eq '' && $depth == 0) {
                   13408:             $cats->[$depth][$categories->{$item}] = $cat;
                   13409:         } else {
                   13410:             $cats->[$depth]{$container}[$categories->{$item}] = $cat;
                   13411:         }
                   13412:         my ($escitem,$tail) = split(/:/,$item,2);
                   13413:         if ($counters{$tail} eq '') {
                   13414:             $counters{$tail} = $num;
                   13415:             $num ++;
                   13416:         }
                   13417:         if (ref($idx) eq 'HASH') {
                   13418:             $idx->{$item} = $counters{$tail};
                   13419:         }
                   13420:         if (ref($jsarray) eq 'ARRAY') {
                   13421:             push(@{$jsarray->[$counters{$tail}]},$item);
                   13422:         }
                   13423:     }
                   13424:     return;
                   13425: }
                   13426: 
                   13427: =pod
                   13428: 
                   13429: =item * &extract_categories()
                   13430: 
                   13431: Used to generate breadcrumb trails for course categories.
                   13432: 
                   13433: Inputs:
1.663     raeburn  13434: 
1.655     raeburn  13435: categories (reference to hash of category definitions).
1.663     raeburn  13436: 
1.655     raeburn  13437: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13438:       categories and subcategories).
1.663     raeburn  13439: 
1.655     raeburn  13440: trails (reference to array of breacrumb trails for each category).
1.663     raeburn  13441: 
1.655     raeburn  13442: allitems (reference to hash - key is category key 
                   13443:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13444: 
1.655     raeburn  13445: idx (reference to hash of counters used in Domain Coordinator interface for
                   13446:       editing Course Categories).
1.663     raeburn  13447: 
1.655     raeburn  13448: jsarray (reference to array of categories used to create Javascript arrays for
                   13449:          Domain Coordinator interface for editing Course Categories).
                   13450: 
1.665     raeburn  13451: subcats (reference to hash of arrays containing all subcategories within each 
                   13452:          category, -recursive)
                   13453: 
1.655     raeburn  13454: Returns: nothing
                   13455: 
                   13456: Side effects: populates trails and allitems hash references.
                   13457: 
                   13458: =cut
                   13459: 
                   13460: sub extract_categories {
1.665     raeburn  13461:     my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655     raeburn  13462:     if (ref($categories) eq 'HASH') {
                   13463:         &gather_categories($categories,$cats,$idx,$jsarray);
                   13464:         if (ref($cats->[0]) eq 'ARRAY') {
                   13465:             for (my $i=0; $i<@{$cats->[0]}; $i++) {
                   13466:                 my $name = $cats->[0][$i];
                   13467:                 my $item = &escape($name).'::0';
                   13468:                 my $trailstr;
                   13469:                 if ($name eq 'instcode') {
                   13470:                     $trailstr = &mt('Official courses (with institutional codes)');
1.919     raeburn  13471:                 } elsif ($name eq 'communities') {
                   13472:                     $trailstr = &mt('Communities');
1.655     raeburn  13473:                 } else {
                   13474:                     $trailstr = $name;
                   13475:                 }
                   13476:                 if ($allitems->{$item} eq '') {
                   13477:                     push(@{$trails},$trailstr);
                   13478:                     $allitems->{$item} = scalar(@{$trails})-1;
                   13479:                 }
                   13480:                 my @parents = ($name);
                   13481:                 if (ref($cats->[1]{$name}) eq 'ARRAY') {
                   13482:                     for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
                   13483:                         my $category = $cats->[1]{$name}[$j];
1.665     raeburn  13484:                         if (ref($subcats) eq 'HASH') {
                   13485:                             push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
                   13486:                         }
                   13487:                         &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
                   13488:                     }
                   13489:                 } else {
                   13490:                     if (ref($subcats) eq 'HASH') {
                   13491:                         $subcats->{$item} = [];
1.655     raeburn  13492:                     }
                   13493:                 }
                   13494:             }
                   13495:         }
                   13496:     }
                   13497:     return;
                   13498: }
                   13499: 
                   13500: =pod
                   13501: 
1.1075.2.56  raeburn  13502: =item * &recurse_categories()
1.655     raeburn  13503: 
                   13504: Recursively used to generate breadcrumb trails for course categories.
                   13505: 
                   13506: Inputs:
1.663     raeburn  13507: 
1.655     raeburn  13508: cats (reference to array of arrays/hashes which encapsulates hierarchy of
                   13509:       categories and subcategories).
1.663     raeburn  13510: 
1.655     raeburn  13511: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663     raeburn  13512: 
                   13513: category (current course category, for which breadcrumb trail is being generated).
                   13514: 
                   13515: trails (reference to array of breadcrumb trails for each category).
                   13516: 
1.655     raeburn  13517: allitems (reference to hash - key is category key
                   13518:          (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663     raeburn  13519: 
1.655     raeburn  13520: parents (array containing containers directories for current category, 
                   13521:          back to top level). 
                   13522: 
                   13523: Returns: nothing
                   13524: 
                   13525: Side effects: populates trails and allitems hash references
                   13526: 
                   13527: =cut
                   13528: 
                   13529: sub recurse_categories {
1.665     raeburn  13530:     my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655     raeburn  13531:     my $shallower = $depth - 1;
                   13532:     if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
                   13533:         for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
                   13534:             my $name = $cats->[$depth]{$category}[$k];
                   13535:             my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13536:             my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13537:             if ($allitems->{$item} eq '') {
                   13538:                 push(@{$trails},$trailstr);
                   13539:                 $allitems->{$item} = scalar(@{$trails})-1;
                   13540:             }
                   13541:             my $deeper = $depth+1;
                   13542:             push(@{$parents},$category);
1.665     raeburn  13543:             if (ref($subcats) eq 'HASH') {
                   13544:                 my $subcat = &escape($name).':'.$category.':'.$depth;
                   13545:                 for (my $j=@{$parents}; $j>=0; $j--) {
                   13546:                     my $higher;
                   13547:                     if ($j > 0) {
                   13548:                         $higher = &escape($parents->[$j]).':'.
                   13549:                                   &escape($parents->[$j-1]).':'.$j;
                   13550:                     } else {
                   13551:                         $higher = &escape($parents->[$j]).'::'.$j;
                   13552:                     }
                   13553:                     push(@{$subcats->{$higher}},$subcat);
                   13554:                 }
                   13555:             }
                   13556:             &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
                   13557:                                 $subcats);
1.655     raeburn  13558:             pop(@{$parents});
                   13559:         }
                   13560:     } else {
                   13561:         my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
                   13562:         my $trailstr = join(' -&gt; ',(@{$parents},$category));
                   13563:         if ($allitems->{$item} eq '') {
                   13564:             push(@{$trails},$trailstr);
                   13565:             $allitems->{$item} = scalar(@{$trails})-1;
                   13566:         }
                   13567:     }
                   13568:     return;
                   13569: }
                   13570: 
1.663     raeburn  13571: =pod
                   13572: 
1.1075.2.56  raeburn  13573: =item * &assign_categories_table()
1.663     raeburn  13574: 
                   13575: Create a datatable for display of hierarchical categories in a domain,
                   13576: with checkboxes to allow a course to be categorized. 
                   13577: 
                   13578: Inputs:
                   13579: 
                   13580: cathash - reference to hash of categories defined for the domain (from
                   13581:           configuration.db)
                   13582: 
                   13583: currcat - scalar with an & separated list of categories assigned to a course. 
                   13584: 
1.919     raeburn  13585: type    - scalar contains course type (Course or Community).
                   13586: 
1.663     raeburn  13587: Returns: $output (markup to be displayed) 
                   13588: 
                   13589: =cut
                   13590: 
                   13591: sub assign_categories_table {
1.919     raeburn  13592:     my ($cathash,$currcat,$type) = @_;
1.663     raeburn  13593:     my $output;
                   13594:     if (ref($cathash) eq 'HASH') {
                   13595:         my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
                   13596:         &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
                   13597:         $maxdepth = scalar(@cats);
                   13598:         if (@cats > 0) {
                   13599:             my $itemcount = 0;
                   13600:             if (ref($cats[0]) eq 'ARRAY') {
                   13601:                 my @currcategories;
                   13602:                 if ($currcat ne '') {
                   13603:                     @currcategories = split('&',$currcat);
                   13604:                 }
1.919     raeburn  13605:                 my $table;
1.663     raeburn  13606:                 for (my $i=0; $i<@{$cats[0]}; $i++) {
                   13607:                     my $parent = $cats[0][$i];
1.919     raeburn  13608:                     next if ($parent eq 'instcode');
                   13609:                     if ($type eq 'Community') {
                   13610:                         next unless ($parent eq 'communities');
                   13611:                     } else {
                   13612:                         next if ($parent eq 'communities');
                   13613:                     }
1.663     raeburn  13614:                     my $css_class = $itemcount%2?' class="LC_odd_row"':'';
                   13615:                     my $item = &escape($parent).'::0';
                   13616:                     my $checked = '';
                   13617:                     if (@currcategories > 0) {
                   13618:                         if (grep(/^\Q$item\E$/,@currcategories)) {
1.772     bisitz   13619:                             $checked = ' checked="checked"';
1.663     raeburn  13620:                         }
                   13621:                     }
1.919     raeburn  13622:                     my $parent_title = $parent;
                   13623:                     if ($parent eq 'communities') {
                   13624:                         $parent_title = &mt('Communities');
                   13625:                     }
                   13626:                     $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
                   13627:                               '<input type="checkbox" name="usecategory" value="'.
                   13628:                               $item.'"'.$checked.' />'.$parent_title.'</span>'.
                   13629:                               '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663     raeburn  13630:                     my $depth = 1;
                   13631:                     push(@path,$parent);
1.919     raeburn  13632:                     $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663     raeburn  13633:                     pop(@path);
1.919     raeburn  13634:                     $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663     raeburn  13635:                     $itemcount ++;
                   13636:                 }
1.919     raeburn  13637:                 if ($itemcount) {
                   13638:                     $output = &Apache::loncommon::start_data_table().
                   13639:                               $table.
                   13640:                               &Apache::loncommon::end_data_table();
                   13641:                 }
1.663     raeburn  13642:             }
                   13643:         }
                   13644:     }
                   13645:     return $output;
                   13646: }
                   13647: 
                   13648: =pod
                   13649: 
1.1075.2.56  raeburn  13650: =item * &assign_category_rows()
1.663     raeburn  13651: 
                   13652: Create a datatable row for display of nested categories in a domain,
                   13653: with checkboxes to allow a course to be categorized,called recursively.
                   13654: 
                   13655: Inputs:
                   13656: 
                   13657: itemcount - track row number for alternating colors
                   13658: 
                   13659: cats - reference to array of arrays/hashes which encapsulates hierarchy of
                   13660:       categories and subcategories.
                   13661: 
                   13662: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
                   13663: 
                   13664: parent - parent of current category item
                   13665: 
                   13666: path - Array containing all categories back up through the hierarchy from the
                   13667:        current category to the top level.
                   13668: 
                   13669: currcategories - reference to array of current categories assigned to the course
                   13670: 
                   13671: Returns: $output (markup to be displayed).
                   13672: 
                   13673: =cut
                   13674: 
                   13675: sub assign_category_rows {
                   13676:     my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
                   13677:     my ($text,$name,$item,$chgstr);
                   13678:     if (ref($cats) eq 'ARRAY') {
                   13679:         my $maxdepth = scalar(@{$cats});
                   13680:         if (ref($cats->[$depth]) eq 'HASH') {
                   13681:             if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
                   13682:                 my $numchildren = @{$cats->[$depth]{$parent}};
                   13683:                 my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45  raeburn  13684:                 $text .= '<td><table class="LC_data_table">';
1.663     raeburn  13685:                 for (my $j=0; $j<$numchildren; $j++) {
                   13686:                     $name = $cats->[$depth]{$parent}[$j];
                   13687:                     $item = &escape($name).':'.&escape($parent).':'.$depth;
                   13688:                     my $deeper = $depth+1;
                   13689:                     my $checked = '';
                   13690:                     if (ref($currcategories) eq 'ARRAY') {
                   13691:                         if (@{$currcategories} > 0) {
                   13692:                             if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772     bisitz   13693:                                 $checked = ' checked="checked"';
1.663     raeburn  13694:                             }
                   13695:                         }
                   13696:                     }
1.664     raeburn  13697:                     $text .= '<tr><td><span class="LC_nobreak"><label>'.
                   13698:                              '<input type="checkbox" name="usecategory" value="'.
1.675     raeburn  13699:                              $item.'"'.$checked.' />'.$name.'</label></span>'.
                   13700:                              '<input type="hidden" name="catname" value="'.$name.'" />'.
                   13701:                              '</td><td>';
1.663     raeburn  13702:                     if (ref($path) eq 'ARRAY') {
                   13703:                         push(@{$path},$name);
                   13704:                         $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
                   13705:                         pop(@{$path});
                   13706:                     }
                   13707:                     $text .= '</td></tr>';
                   13708:                 }
                   13709:                 $text .= '</table></td>';
                   13710:             }
                   13711:         }
                   13712:     }
                   13713:     return $text;
                   13714: }
                   13715: 
1.1075.2.69  raeburn  13716: =pod
                   13717: 
                   13718: =back
                   13719: 
                   13720: =cut
                   13721: 
1.655     raeburn  13722: ############################################################
                   13723: ############################################################
                   13724: 
                   13725: 
1.443     albertel 13726: sub commit_customrole {
1.664     raeburn  13727:     my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630     raeburn  13728:     my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443     albertel 13729:                          ($start?', '.&mt('starting').' '.localtime($start):'').
                   13730:                          ($end?', ending '.localtime($end):'').': <b>'.
                   13731:               &Apache::lonnet::assigncustomrole(
1.664     raeburn  13732:                  $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443     albertel 13733:                  '</b><br />';
                   13734:     return $output;
                   13735: }
                   13736: 
                   13737: sub commit_standardrole {
1.1075.2.31  raeburn  13738:     my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541     raeburn  13739:     my ($output,$logmsg,$linefeed);
                   13740:     if ($context eq 'auto') {
                   13741:         $linefeed = "\n";
                   13742:     } else {
                   13743:         $linefeed = "<br />\n";
                   13744:     }  
1.443     albertel 13745:     if ($three eq 'st') {
1.541     raeburn  13746:         my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31  raeburn  13747:                                          $one,$two,$sec,$context,$credits);
1.541     raeburn  13748:         if (($result =~ /^error/) || ($result eq 'not_in_class') || 
1.626     raeburn  13749:             ($result eq 'unknown_course') || ($result eq 'refused')) {
                   13750:             $output = $logmsg.' '.&mt('Error: ').$result."\n"; 
1.443     albertel 13751:         } else {
1.541     raeburn  13752:             $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443     albertel 13753:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13754:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
                   13755:             if ($context eq 'auto') {
                   13756:                 $output .= $result.$linefeed.&mt('Add to classlist').': ok';
                   13757:             } else {
                   13758:                $output .= '<b>'.$result.'</b>'.$linefeed.
                   13759:                &mt('Add to classlist').': <b>ok</b>';
                   13760:             }
                   13761:             $output .= $linefeed;
1.443     albertel 13762:         }
                   13763:     } else {
                   13764:         $output = &mt('Assigning').' '.$three.' in '.$url.
                   13765:                ($start?', '.&mt('starting').' '.localtime($start):'').
1.541     raeburn  13766:                ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652     raeburn  13767:         my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541     raeburn  13768:         if ($context eq 'auto') {
                   13769:             $output .= $result.$linefeed;
                   13770:         } else {
                   13771:             $output .= '<b>'.$result.'</b>'.$linefeed;
                   13772:         }
1.443     albertel 13773:     }
                   13774:     return $output;
                   13775: }
                   13776: 
                   13777: sub commit_studentrole {
1.1075.2.31  raeburn  13778:     my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
                   13779:         $credits) = @_;
1.626     raeburn  13780:     my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541     raeburn  13781:     if ($context eq 'auto') {
                   13782:         $linefeed = "\n";
                   13783:     } else {
                   13784:         $linefeed = '<br />'."\n";
                   13785:     }
1.443     albertel 13786:     if (defined($one) && defined($two)) {
                   13787:         my $cid=$one.'_'.$two;
                   13788:         my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
                   13789:         my $secchange = 0;
                   13790:         my $expire_role_result;
                   13791:         my $modify_section_result;
1.628     raeburn  13792:         if ($oldsec ne '-1') { 
                   13793:             if ($oldsec ne $sec) {
1.443     albertel 13794:                 $secchange = 1;
1.628     raeburn  13795:                 my $now = time;
1.443     albertel 13796:                 my $uurl='/'.$cid;
                   13797:                 $uurl=~s/\_/\//g;
                   13798:                 if ($oldsec) {
                   13799:                     $uurl.='/'.$oldsec;
                   13800:                 }
1.626     raeburn  13801:                 $oldsecurl = $uurl;
1.628     raeburn  13802:                 $expire_role_result = 
1.652     raeburn  13803:                     &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628     raeburn  13804:                 if ($env{'request.course.sec'} ne '') { 
                   13805:                     if ($expire_role_result eq 'refused') {
                   13806:                         my @roles = ('st');
                   13807:                         my @statuses = ('previous');
                   13808:                         my @roledoms = ($one);
                   13809:                         my $withsec = 1;
                   13810:                         my %roleshash = 
                   13811:                             &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
                   13812:                                               \@statuses,\@roles,\@roledoms,$withsec);
                   13813:                         if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
                   13814:                             my ($oldstart,$oldend) = 
                   13815:                                 split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
                   13816:                             if ($oldend > 0 && $oldend <= $now) {
                   13817:                                 $expire_role_result = 'ok';
                   13818:                             }
                   13819:                         }
                   13820:                     }
                   13821:                 }
1.443     albertel 13822:                 $result = $expire_role_result;
                   13823:             }
                   13824:         }
                   13825:         if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31  raeburn  13826:             $modify_section_result = 
                   13827:                 &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
                   13828:                                                            undef,undef,undef,$sec,
                   13829:                                                            $end,$start,'','',$cid,
                   13830:                                                            '',$context,$credits);
1.443     albertel 13831:             if ($modify_section_result =~ /^ok/) {
                   13832:                 if ($secchange == 1) {
1.628     raeburn  13833:                     if ($sec eq '') {
                   13834:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
                   13835:                     } else {
                   13836:                         $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
                   13837:                     }
1.443     albertel 13838:                 } elsif ($oldsec eq '-1') {
1.628     raeburn  13839:                     if ($sec eq '') {
                   13840:                         $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
                   13841:                     } else {
                   13842:                         $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13843:                     }
1.443     albertel 13844:                 } else {
1.628     raeburn  13845:                     if ($sec eq '') {
                   13846:                         $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
                   13847:                     } else {
                   13848:                         $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
                   13849:                     }
1.443     albertel 13850:                 }
                   13851:             } else {
1.628     raeburn  13852:                 if ($secchange) {       
                   13853:                     $$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;
                   13854:                 } else {
                   13855:                     $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
                   13856:                 }
1.443     albertel 13857:             }
                   13858:             $result = $modify_section_result;
                   13859:         } elsif ($secchange == 1) {
1.628     raeburn  13860:             if ($oldsec eq '') {
1.1075.2.20  raeburn  13861:                 $$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  13862:             } else {
                   13863:                 $$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;
                   13864:             }
1.626     raeburn  13865:             if ($expire_role_result eq 'refused') {
                   13866:                 my $newsecurl = '/'.$cid;
                   13867:                 $newsecurl =~ s/\_/\//g;
                   13868:                 if ($sec ne '') {
                   13869:                     $newsecurl.='/'.$sec;
                   13870:                 }
                   13871:                 if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
                   13872:                     if ($sec eq '') {
                   13873:                         $$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;
                   13874:                     } else {
                   13875:                         $$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;
                   13876:                     }
                   13877:                 }
                   13878:             }
1.443     albertel 13879:         }
                   13880:     } else {
1.626     raeburn  13881:         $$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 13882:         $result = "error: incomplete course id\n";
                   13883:     }
                   13884:     return $result;
                   13885: }
                   13886: 
1.1075.2.25  raeburn  13887: sub show_role_extent {
                   13888:     my ($scope,$context,$role) = @_;
                   13889:     $scope =~ s{^/}{};
                   13890:     my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
                   13891:     push(@courseroles,'co');
                   13892:     my @authorroles = &Apache::lonuserutils::roles_by_context('author');
                   13893:     if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
                   13894:         $scope =~ s{/}{_};
                   13895:         return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
                   13896:     } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
                   13897:         my ($audom,$auname) = split(/\//,$scope);
                   13898:         return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
                   13899:                    &Apache::loncommon::plainname($auname,$audom).'</span>');
                   13900:     } else {
                   13901:         $scope =~ s{/$}{};
                   13902:         return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
                   13903:                    &Apache::lonnet::domain($scope,'description').'</span>');
                   13904:     }
                   13905: }
                   13906: 
1.443     albertel 13907: ############################################################
                   13908: ############################################################
                   13909: 
1.566     albertel 13910: sub check_clone {
1.578     raeburn  13911:     my ($args,$linefeed) = @_;
1.566     albertel 13912:     my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
                   13913:     my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
                   13914:     my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
                   13915:     my $clonemsg;
                   13916:     my $can_clone = 0;
1.944     raeburn  13917:     my $lctype = lc($args->{'crstype'});
1.908     raeburn  13918:     if ($lctype ne 'community') {
                   13919:         $lctype = 'course';
                   13920:     }
1.566     albertel 13921:     if ($clonehome eq 'no_host') {
1.944     raeburn  13922:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13923:             $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'});
                   13924:         } else {
                   13925:             $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'});
                   13926:         }     
1.566     albertel 13927:     } else {
                   13928: 	my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944     raeburn  13929:         if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13930:             if ($clonedesc{'type'} ne 'Community') {
                   13931:                  $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'});
                   13932:                 return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13933:             }
                   13934:         }
1.882     raeburn  13935: 	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && 
                   13936:             (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566     albertel 13937: 	    $can_clone = 1;
                   13938: 	} else {
                   13939: 	    my %clonehash = &Apache::lonnet::get('environment',['cloners'],
                   13940: 						 $args->{'clonedomain'},$args->{'clonecourse'});
                   13941: 	    my @cloners = split(/,/,$clonehash{'cloners'});
1.578     raeburn  13942:             if (grep(/^\*$/,@cloners)) {
                   13943:                 $can_clone = 1;
                   13944:             } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
                   13945:                 $can_clone = 1;
                   13946:             } else {
1.908     raeburn  13947:                 my $ccrole = 'cc';
1.944     raeburn  13948:                 if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13949:                     $ccrole = 'co';
                   13950:                 }
1.578     raeburn  13951: 	        my %roleshash =
                   13952: 		    &Apache::lonnet::get_my_roles($args->{'ccuname'},
                   13953: 					 $args->{'ccdomain'},
1.908     raeburn  13954:                                          'userroles',['active'],[$ccrole],
1.578     raeburn  13955: 					 [$args->{'clonedomain'}]);
1.908     raeburn  13956: 	        if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942     raeburn  13957:                     $can_clone = 1;
                   13958:                 } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
                   13959:                     $can_clone = 1;
                   13960:                 } else {
1.944     raeburn  13961:                     if ($args->{'crstype'} eq 'Community') {
1.908     raeburn  13962:                         $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'});
                   13963:                     } else {
                   13964:                         $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'});
                   13965:                     }
1.578     raeburn  13966: 	        }
1.566     albertel 13967: 	    }
1.578     raeburn  13968:         }
1.566     albertel 13969:     }
                   13970:     return ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13971: }
                   13972: 
1.444     albertel 13973: sub construct_course {
1.1075.2.59  raeburn  13974:     my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444     albertel 13975:     my $outcome;
1.541     raeburn  13976:     my $linefeed =  '<br />'."\n";
                   13977:     if ($context eq 'auto') {
                   13978:         $linefeed = "\n";
                   13979:     }
1.566     albertel 13980: 
                   13981: #
                   13982: # Are we cloning?
                   13983: #
                   13984:     my ($can_clone, $clonemsg, $cloneid, $clonehome);
                   13985:     if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578     raeburn  13986: 	($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566     albertel 13987: 	if ($context ne 'auto') {
1.578     raeburn  13988:             if ($clonemsg ne '') {
                   13989: 	        $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
                   13990:             }
1.566     albertel 13991: 	}
                   13992: 	$outcome .= $clonemsg.$linefeed;
                   13993: 
                   13994:         if (!$can_clone) {
                   13995: 	    return (0,$outcome);
                   13996: 	}
                   13997:     }
                   13998: 
1.444     albertel 13999: #
                   14000: # Open course
                   14001: #
                   14002:     my $crstype = lc($args->{'crstype'});
                   14003:     my %cenv=();
                   14004:     $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
                   14005:                                              $args->{'cdescr'},
                   14006:                                              $args->{'curl'},
                   14007:                                              $args->{'course_home'},
                   14008:                                              $args->{'nonstandard'},
                   14009:                                              $args->{'crscode'},
                   14010:                                              $args->{'ccuname'}.':'.
                   14011:                                              $args->{'ccdomain'},
1.882     raeburn  14012:                                              $args->{'crstype'},
1.885     raeburn  14013:                                              $cnum,$context,$category);
1.444     albertel 14014: 
                   14015:     # Note: The testing routines depend on this being output; see 
                   14016:     # Utils::Course. This needs to at least be output as a comment
                   14017:     # if anyone ever decides to not show this, and Utils::Course::new
                   14018:     # will need to be suitably modified.
1.541     raeburn  14019:     $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943     raeburn  14020:     if ($$courseid =~ /^error:/) {
                   14021:         return (0,$outcome);
                   14022:     }
                   14023: 
1.444     albertel 14024: #
                   14025: # Check if created correctly
                   14026: #
1.479     albertel 14027:     ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444     albertel 14028:     my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943     raeburn  14029:     if ($crsuhome eq 'no_host') {
                   14030:         $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
                   14031:         return (0,$outcome);
                   14032:     }
1.541     raeburn  14033:     $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566     albertel 14034: 
1.444     albertel 14035: #
1.566     albertel 14036: # Do the cloning
                   14037: #   
                   14038:     if ($can_clone && $cloneid) {
                   14039: 	$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
                   14040: 	if ($context ne 'auto') {
                   14041: 	    $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
                   14042: 	}
                   14043: 	$outcome .= $clonemsg.$linefeed;
                   14044: 	my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444     albertel 14045: # Copy all files
1.637     www      14046: 	&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444     albertel 14047: # Restore URL
1.566     albertel 14048: 	$cenv{'url'}=$oldcenv{'url'};
1.444     albertel 14049: # Restore title
1.566     albertel 14050: 	$cenv{'description'}=$oldcenv{'description'};
1.955     raeburn  14051: # Restore creation date, creator and creation context.
                   14052:         $cenv{'internal.created'}=$oldcenv{'internal.created'};
                   14053:         $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
                   14054:         $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444     albertel 14055: # Mark as cloned
1.566     albertel 14056: 	$cenv{'clonedfrom'}=$cloneid;
1.638     www      14057: # Need to clone grading mode
                   14058:         my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
                   14059:         $cenv{'grading'}=$newenv{'grading'};
                   14060: # Do not clone these environment entries
                   14061:         &Apache::lonnet::del('environment',
                   14062:                   ['default_enrollment_start_date',
                   14063:                    'default_enrollment_end_date',
                   14064:                    'question.email',
                   14065:                    'policy.email',
                   14066:                    'comment.email',
                   14067:                    'pch.users.denied',
1.725     raeburn  14068:                    'plc.users.denied',
                   14069:                    'hidefromcat',
1.1075.2.36  raeburn  14070:                    'checkforpriv',
1.1075.2.59  raeburn  14071:                    'categories',
                   14072:                    'internal.uniquecode'],
1.638     www      14073:                    $$crsudom,$$crsunum);
1.1075.2.63  raeburn  14074:         if ($args->{'textbook'}) {
                   14075:             $cenv{'internal.textbook'} = $args->{'textbook'};
                   14076:         }
1.444     albertel 14077:     }
1.566     albertel 14078: 
1.444     albertel 14079: #
                   14080: # Set environment (will override cloned, if existing)
                   14081: #
                   14082:     my @sections = ();
                   14083:     my @xlists = ();
                   14084:     if ($args->{'crstype'}) {
                   14085:         $cenv{'type'}=$args->{'crstype'};
                   14086:     }
                   14087:     if ($args->{'crsid'}) {
                   14088:         $cenv{'courseid'}=$args->{'crsid'};
                   14089:     }
                   14090:     if ($args->{'crscode'}) {
                   14091:         $cenv{'internal.coursecode'}=$args->{'crscode'};
                   14092:     }
                   14093:     if ($args->{'crsquota'} ne '') {
                   14094:         $cenv{'internal.coursequota'}=$args->{'crsquota'};
                   14095:     } else {
                   14096:         $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
                   14097:     }
                   14098:     if ($args->{'ccuname'}) {
                   14099:         $cenv{'internal.courseowner'} = $args->{'ccuname'}.
                   14100:                                         ':'.$args->{'ccdomain'};
                   14101:     } else {
                   14102:         $cenv{'internal.courseowner'} = $args->{'curruser'};
                   14103:     }
1.1075.2.31  raeburn  14104:     if ($args->{'defaultcredits'}) {
                   14105:         $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
                   14106:     }
1.444     albertel 14107:     my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
                   14108:     if ($args->{'crssections'}) {
                   14109:         $cenv{'internal.sectionnums'} = '';
                   14110:         if ($args->{'crssections'} =~ m/,/) {
                   14111:             @sections = split/,/,$args->{'crssections'};
                   14112:         } else {
                   14113:             $sections[0] = $args->{'crssections'};
                   14114:         }
                   14115:         if (@sections > 0) {
                   14116:             foreach my $item (@sections) {
                   14117:                 my ($sec,$gp) = split/:/,$item;
                   14118:                 my $class = $args->{'crscode'}.$sec;
                   14119:                 my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
                   14120:                 $cenv{'internal.sectionnums'} .= $item.',';
                   14121:                 unless ($addcheck eq 'ok') {
                   14122:                     push @badclasses, $class;
                   14123:                 }
                   14124:             }
                   14125:             $cenv{'internal.sectionnums'} =~ s/,$//;
                   14126:         }
                   14127:     }
                   14128: # do not hide course coordinator from staff listing, 
                   14129: # even if privileged
                   14130:     $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36  raeburn  14131: # add course coordinator's domain to domains to check for privileged users
                   14132: # if different to course domain
                   14133:     if ($$crsudom ne $args->{'ccdomain'}) {
                   14134:         $cenv{'checkforpriv'} = $args->{'ccdomain'};
                   14135:     }
1.444     albertel 14136: # add crosslistings
                   14137:     if ($args->{'crsxlist'}) {
                   14138:         $cenv{'internal.crosslistings'}='';
                   14139:         if ($args->{'crsxlist'} =~ m/,/) {
                   14140:             @xlists = split/,/,$args->{'crsxlist'};
                   14141:         } else {
                   14142:             $xlists[0] = $args->{'crsxlist'};
                   14143:         }
                   14144:         if (@xlists > 0) {
                   14145:             foreach my $item (@xlists) {
                   14146:                 my ($xl,$gp) = split/:/,$item;
                   14147:                 my $addcheck =  &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
                   14148:                 $cenv{'internal.crosslistings'} .= $item.',';
                   14149:                 unless ($addcheck eq 'ok') {
                   14150:                     push @badclasses, $xl;
                   14151:                 }
                   14152:             }
                   14153:             $cenv{'internal.crosslistings'} =~ s/,$//;
                   14154:         }
                   14155:     }
                   14156:     if ($args->{'autoadds'}) {
                   14157:         $cenv{'internal.autoadds'}=$args->{'autoadds'};
                   14158:     }
                   14159:     if ($args->{'autodrops'}) {
                   14160:         $cenv{'internal.autodrops'}=$args->{'autodrops'};
                   14161:     }
                   14162: # check for notification of enrollment changes
                   14163:     my @notified = ();
                   14164:     if ($args->{'notify_owner'}) {
                   14165:         if ($args->{'ccuname'} ne '') {
                   14166:             push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
                   14167:         }
                   14168:     }
                   14169:     if ($args->{'notify_dc'}) {
                   14170:         if ($uname ne '') { 
1.630     raeburn  14171:             push(@notified,$uname.':'.$udom);
1.444     albertel 14172:         }
                   14173:     }
                   14174:     if (@notified > 0) {
                   14175:         my $notifylist;
                   14176:         if (@notified > 1) {
                   14177:             $notifylist = join(',',@notified);
                   14178:         } else {
                   14179:             $notifylist = $notified[0];
                   14180:         }
                   14181:         $cenv{'internal.notifylist'} = $notifylist;
                   14182:     }
                   14183:     if (@badclasses > 0) {
                   14184:         my %lt=&Apache::lonlocal::texthash(
                   14185:                 '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',
                   14186:                 'dnhr' => 'does not have rights to access enrollment in these classes',
                   14187:                 'adby' => 'as determined by the policies of your institution on access to official classlists'
                   14188:         );
1.541     raeburn  14189:         my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
                   14190:                            ' ('.$lt{'adby'}.')';
                   14191:         if ($context eq 'auto') {
                   14192:             $outcome .= $badclass_msg.$linefeed;
1.566     albertel 14193:             $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541     raeburn  14194:             foreach my $item (@badclasses) {
                   14195:                 if ($context eq 'auto') {
                   14196:                     $outcome .= " - $item\n";
                   14197:                 } else {
                   14198:                     $outcome .= "<li>$item</li>\n";
                   14199:                 }
                   14200:             }
                   14201:             if ($context eq 'auto') {
                   14202:                 $outcome .= $linefeed;
                   14203:             } else {
1.566     albertel 14204:                 $outcome .= "</ul><br /><br /></div>\n";
1.541     raeburn  14205:             }
                   14206:         } 
1.444     albertel 14207:     }
                   14208:     if ($args->{'no_end_date'}) {
                   14209:         $args->{'endaccess'} = 0;
                   14210:     }
                   14211:     $cenv{'internal.autostart'}=$args->{'enrollstart'};
                   14212:     $cenv{'internal.autoend'}=$args->{'enrollend'};
                   14213:     $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
                   14214:     $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
                   14215:     if ($args->{'showphotos'}) {
                   14216:       $cenv{'internal.showphotos'}=$args->{'showphotos'};
                   14217:     }
                   14218:     $cenv{'internal.authtype'} = $args->{'authtype'};
                   14219:     $cenv{'internal.autharg'} = $args->{'autharg'}; 
                   14220:     if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
                   14221:         if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'}  eq '') {
1.541     raeburn  14222:             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'); 
                   14223:             if ($context eq 'auto') {
                   14224:                 $outcome .= $krb_msg;
                   14225:             } else {
1.566     albertel 14226:                 $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541     raeburn  14227:             }
                   14228:             $outcome .= $linefeed;
1.444     albertel 14229:         }
                   14230:     }
                   14231:     if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
                   14232:        if ($args->{'setpolicy'}) {
                   14233:            $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14234:        }
                   14235:        if ($args->{'setcontent'}) {
                   14236:            $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
                   14237:        }
                   14238:     }
                   14239:     if ($args->{'reshome'}) {
                   14240: 	$cenv{'reshome'}=$args->{'reshome'}.'/';
                   14241: 	$cenv{'reshome'}=~s/\/+$/\//;
                   14242:     }
                   14243: #
                   14244: # course has keyed access
                   14245: #
                   14246:     if ($args->{'setkeys'}) {
                   14247:        $cenv{'keyaccess'}='yes';
                   14248:     }
                   14249: # if specified, key authority is not course, but user
                   14250: # only active if keyaccess is yes
                   14251:     if ($args->{'keyauth'}) {
1.487     albertel 14252: 	my ($user,$domain) = split(':',$args->{'keyauth'});
                   14253: 	$user = &LONCAPA::clean_username($user);
                   14254: 	$domain = &LONCAPA::clean_username($domain);
1.488     foxr     14255: 	if ($user ne '' && $domain ne '') {
1.487     albertel 14256: 	    $cenv{'keyauth'}=$user.':'.$domain;
1.444     albertel 14257: 	}
                   14258:     }
                   14259: 
1.1075.2.59  raeburn  14260: #
                   14261: #  generate and store uniquecode (available to course requester), if course should have one.
                   14262: #
                   14263:     if ($args->{'uniquecode'}) {
                   14264:         my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
                   14265:         if ($code) {
                   14266:             $cenv{'internal.uniquecode'} = $code;
                   14267:             my %crsinfo =
                   14268:                 &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
                   14269:             if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
                   14270:                 $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
                   14271:                 my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
                   14272:             }
                   14273:             if (ref($coderef)) {
                   14274:                 $$coderef = $code;
                   14275:             }
                   14276:         }
                   14277:     }
                   14278: 
1.444     albertel 14279:     if ($args->{'disresdis'}) {
                   14280:         $cenv{'pch.roles.denied'}='st';
                   14281:     }
                   14282:     if ($args->{'disablechat'}) {
                   14283:         $cenv{'plc.roles.denied'}='st';
                   14284:     }
                   14285: 
                   14286:     # Record we've not yet viewed the Course Initialization Helper for this 
                   14287:     # course
                   14288:     $cenv{'course.helper.not.run'} = 1;
                   14289:     #
                   14290:     # Use new Randomseed
                   14291:     #
                   14292:     $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
                   14293:     $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
                   14294:     #
                   14295:     # The encryption code and receipt prefix for this course
                   14296:     #
                   14297:     $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
                   14298:     $cenv{'internal.encpref'}=100+int(9*rand(99));
                   14299:     #
                   14300:     # By default, use standard grading
                   14301:     if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
                   14302: 
1.541     raeburn  14303:     $outcome .= $linefeed.&mt('Setting environment').': '.                 
                   14304:           &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14305: #
                   14306: # Open all assignments
                   14307: #
                   14308:     if ($args->{'openall'}) {
                   14309:        my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
                   14310:        my %storecontent = ($storeunder         => time,
                   14311:                            $storeunder.'.type' => 'date_start');
                   14312:        
                   14313:        $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541     raeburn  14314:                  ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444     albertel 14315:    }
                   14316: #
                   14317: # Set first page
                   14318: #
                   14319:     unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
                   14320: 	    || ($cloneid)) {
1.445     albertel 14321: 	use LONCAPA::map;
1.444     albertel 14322: 	$outcome .= &mt('Setting first resource').': ';
1.445     albertel 14323: 
                   14324: 	my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
                   14325:         my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
                   14326: 
1.444     albertel 14327:         $outcome .= ($fatal?$errtext:'read ok').' - ';
                   14328:         my $title; my $url;
                   14329:         if ($args->{'firstres'} eq 'syl') {
1.690     bisitz   14330: 	    $title=&mt('Syllabus');
1.444     albertel 14331:             $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
                   14332:         } else {
1.963     raeburn  14333:             $title=&mt('Table of Contents');
1.444     albertel 14334:             $url='/adm/navmaps';
                   14335:         }
1.445     albertel 14336: 
                   14337:         $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
                   14338: 	(my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
                   14339: 
                   14340: 	if ($errtext) { $fatal=2; }
1.541     raeburn  14341:         $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444     albertel 14342:     }
1.566     albertel 14343: 
                   14344:     return (1,$outcome);
1.444     albertel 14345: }
                   14346: 
1.1075.2.59  raeburn  14347: sub make_unique_code {
                   14348:     my ($cdom,$cnum) = @_;
                   14349:     # get lock on uniquecodes db
                   14350:     my $lockhash = {
                   14351:                       $cnum."\0".'uniquecodes' => $env{'user.name'}.
                   14352:                                                   ':'.$env{'user.domain'},
                   14353:                    };
                   14354:     my $tries = 0;
                   14355:     my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14356:     my ($code,$error);
                   14357: 
                   14358:     while (($gotlock ne 'ok') && ($tries<3)) {
                   14359:         $tries ++;
                   14360:         sleep 1;
                   14361:         $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
                   14362:     }
                   14363:     if ($gotlock eq 'ok') {
                   14364:         my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
                   14365:         my $gotcode;
                   14366:         my $attempts = 0;
                   14367:         while ((!$gotcode) && ($attempts < 100)) {
                   14368:             $code = &generate_code();
                   14369:             if (!exists($currcodes{$code})) {
                   14370:                 $gotcode = 1;
                   14371:                 unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
                   14372:                     $error = 'nostore';
                   14373:                 }
                   14374:             }
                   14375:             $attempts ++;
                   14376:         }
                   14377:         my @del_lock = ($cnum."\0".'uniquecodes');
                   14378:         my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
                   14379:     } else {
                   14380:         $error = 'nolock';
                   14381:     }
                   14382:     return ($code,$error);
                   14383: }
                   14384: 
                   14385: sub generate_code {
                   14386:     my $code;
                   14387:     my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
                   14388:     for (my $i=0; $i<6; $i++) {
                   14389:         my $lettnum = int (rand 2);
                   14390:         my $item = '';
                   14391:         if ($lettnum) {
                   14392:             $item = $letts[int( rand(18) )];
                   14393:         } else {
                   14394:             $item = 1+int( rand(8) );
                   14395:         }
                   14396:         $code .= $item;
                   14397:     }
                   14398:     return $code;
                   14399: }
                   14400: 
1.444     albertel 14401: ############################################################
                   14402: ############################################################
                   14403: 
1.953     droeschl 14404: #SD
                   14405: # only Community and Course, or anything else?
1.378     raeburn  14406: sub course_type {
                   14407:     my ($cid) = @_;
                   14408:     if (!defined($cid)) {
                   14409:         $cid = $env{'request.course.id'};
                   14410:     }
1.404     albertel 14411:     if (defined($env{'course.'.$cid.'.type'})) {
                   14412:         return $env{'course.'.$cid.'.type'};
1.378     raeburn  14413:     } else {
                   14414:         return 'Course';
1.377     raeburn  14415:     }
                   14416: }
1.156     albertel 14417: 
1.406     raeburn  14418: sub group_term {
                   14419:     my $crstype = &course_type();
                   14420:     my %names = (
                   14421:                   'Course' => 'group',
1.865     raeburn  14422:                   'Community' => 'group',
1.406     raeburn  14423:                 );
                   14424:     return $names{$crstype};
                   14425: }
                   14426: 
1.902     raeburn  14427: sub course_types {
1.1075.2.59  raeburn  14428:     my @types = ('official','unofficial','community','textbook');
1.902     raeburn  14429:     my %typename = (
                   14430:                          official   => 'Official course',
                   14431:                          unofficial => 'Unofficial course',
                   14432:                          community  => 'Community',
1.1075.2.59  raeburn  14433:                          textbook   => 'Textbook course',
1.902     raeburn  14434:                    );
                   14435:     return (\@types,\%typename);
                   14436: }
                   14437: 
1.156     albertel 14438: sub icon {
                   14439:     my ($file)=@_;
1.505     albertel 14440:     my $curfext = lc((split(/\./,$file))[-1]);
1.168     albertel 14441:     my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156     albertel 14442:     my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168     albertel 14443:     if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
                   14444: 	if (-e  $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                   14445: 	          $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14446: 	            $curfext.".gif") {
                   14447: 	    $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
                   14448: 		$curfext.".gif";
                   14449: 	}
                   14450:     }
1.249     albertel 14451:     return &lonhttpdurl($iconname);
1.154     albertel 14452: } 
1.84      albertel 14453: 
1.575     albertel 14454: sub lonhttpdurl {
1.692     www      14455: #
                   14456: # Had been used for "small fry" static images on separate port 8080.
                   14457: # Modify here if lightweight http functionality desired again.
                   14458: # Currently eliminated due to increasing firewall issues.
                   14459: #
1.575     albertel 14460:     my ($url)=@_;
1.692     www      14461:     return $url;
1.215     albertel 14462: }
                   14463: 
1.213     albertel 14464: sub connection_aborted {
                   14465:     my ($r)=@_;
                   14466:     $r->print(" ");$r->rflush();
                   14467:     my $c = $r->connection;
                   14468:     return $c->aborted();
                   14469: }
                   14470: 
1.221     foxr     14471: #    Escapes strings that may have embedded 's that will be put into
1.222     foxr     14472: #    strings as 'strings'.
                   14473: sub escape_single {
1.221     foxr     14474:     my ($input) = @_;
1.223     albertel 14475:     $input =~ s/\\/\\\\/g;	# Escape the \'s..(must be first)>
1.221     foxr     14476:     $input =~ s/\'/\\\'/g;	# Esacpe the 's....
                   14477:     return $input;
                   14478: }
1.223     albertel 14479: 
1.222     foxr     14480: #  Same as escape_single, but escape's "'s  This 
                   14481: #  can be used for  "strings"
                   14482: sub escape_double {
                   14483:     my ($input) = @_;
                   14484:     $input =~ s/\\/\\\\/g;	# Escape the /'s..(must be first)>
                   14485:     $input =~ s/\"/\\\"/g;	# Esacpe the "s....
                   14486:     return $input;
                   14487: }
1.223     albertel 14488:  
1.222     foxr     14489: #   Escapes the last element of a full URL.
                   14490: sub escape_url {
                   14491:     my ($url)   = @_;
1.238     raeburn  14492:     my @urlslices = split(/\//, $url,-1);
1.369     www      14493:     my $lastitem = &escape(pop(@urlslices));
1.1075.2.83  raeburn  14494:     return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222     foxr     14495: }
1.462     albertel 14496: 
1.820     raeburn  14497: sub compare_arrays {
                   14498:     my ($arrayref1,$arrayref2) = @_;
                   14499:     my (@difference,%count);
                   14500:     @difference = ();
                   14501:     %count = ();
                   14502:     if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
                   14503:         foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
                   14504:         foreach my $element (keys(%count)) {
                   14505:             if ($count{$element} == 1) {
                   14506:                 push(@difference,$element);
                   14507:             }
                   14508:         }
                   14509:     }
                   14510:     return @difference;
                   14511: }
                   14512: 
1.817     bisitz   14513: # -------------------------------------------------------- Initialize user login
1.462     albertel 14514: sub init_user_environment {
1.463     albertel 14515:     my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462     albertel 14516:     my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
                   14517: 
                   14518:     my $public=($username eq 'public' && $domain eq 'public');
                   14519: 
                   14520: # See if old ID present, if so, remove
                   14521: 
1.1062    raeburn  14522:     my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462     albertel 14523:     my $now=time;
                   14524: 
                   14525:     if ($public) {
                   14526: 	my $max_public=100;
                   14527: 	my $oldest;
                   14528: 	my $oldest_time=0;
                   14529: 	for(my $next=1;$next<=$max_public;$next++) {
                   14530: 	    if (-e $lonids."/publicuser_$next.id") {
                   14531: 		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
                   14532: 		if ($mtime<$oldest_time || !$oldest_time) {
                   14533: 		    $oldest_time=$mtime;
                   14534: 		    $oldest=$next;
                   14535: 		}
                   14536: 	    } else {
                   14537: 		$cookie="publicuser_$next";
                   14538: 		last;
                   14539: 	    }
                   14540: 	}
                   14541: 	if (!$cookie) { $cookie="publicuser_$oldest"; }
                   14542:     } else {
1.463     albertel 14543: 	# if this isn't a robot, kill any existing non-robot sessions
                   14544: 	if (!$args->{'robot'}) {
                   14545: 	    opendir(DIR,$lonids);
                   14546: 	    while ($filename=readdir(DIR)) {
                   14547: 		if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
                   14548: 		    unlink($lonids.'/'.$filename);
                   14549: 		}
1.462     albertel 14550: 	    }
1.463     albertel 14551: 	    closedir(DIR);
1.1075.2.84! raeburn  14552: # If there is a undeleted lockfile for the user's paste buffer remove it.
        !          14553:             my $namespace = 'nohist_courseeditor';
        !          14554:             my $lockingkey = 'paste'."\0".'locked_num';
        !          14555:             my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
        !          14556:                                                 $domain,$username);
        !          14557:             if (exists($lockhash{$lockingkey})) {
        !          14558:                 my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
        !          14559:                 unless ($delresult eq 'ok') {
        !          14560:                     &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
        !          14561:                 }
        !          14562:             }
1.462     albertel 14563: 	}
                   14564: # Give them a new cookie
1.463     albertel 14565: 	my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684     www      14566: 		                   : $now.$$.int(rand(10000)));
1.463     albertel 14567: 	$cookie="$username\_$id\_$domain\_$authhost";
1.462     albertel 14568:     
                   14569: # Initialize roles
                   14570: 
1.1062    raeburn  14571: 	($userroles,$firstaccenv,$timerintenv) = 
                   14572:             &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462     albertel 14573:     }
                   14574: # ------------------------------------ Check browser type and MathML capability
                   14575: 
1.1075.2.77  raeburn  14576:     my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
                   14577:         $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462     albertel 14578: 
                   14579: # ------------------------------------------------------------- Get environment
                   14580: 
                   14581:     my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
                   14582:     my ($tmp) = keys(%userenv);
                   14583:     if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
                   14584:     } else {
                   14585: 	undef(%userenv);
                   14586:     }
                   14587:     if (($userenv{'interface'}) && (!$form->{'interface'})) {
                   14588: 	$form->{'interface'}=$userenv{'interface'};
                   14589:     }
                   14590:     if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
                   14591: 
                   14592: # --------------- Do not trust query string to be put directly into environment
1.817     bisitz   14593:     foreach my $option ('interface','localpath','localres') {
                   14594:         $form->{$option}=~s/[\n\r\=]//gs;
1.462     albertel 14595:     }
                   14596: # --------------------------------------------------------- Write first profile
                   14597: 
                   14598:     {
                   14599: 	my %initial_env = 
                   14600: 	    ("user.name"          => $username,
                   14601: 	     "user.domain"        => $domain,
                   14602: 	     "user.home"          => $authhost,
                   14603: 	     "browser.type"       => $clientbrowser,
                   14604: 	     "browser.version"    => $clientversion,
                   14605: 	     "browser.mathml"     => $clientmathml,
                   14606: 	     "browser.unicode"    => $clientunicode,
                   14607: 	     "browser.os"         => $clientos,
1.1075.2.42  raeburn  14608:              "browser.mobile"     => $clientmobile,
                   14609:              "browser.info"       => $clientinfo,
1.1075.2.77  raeburn  14610:              "browser.osversion"  => $clientosversion,
1.462     albertel 14611: 	     "server.domain"      => $Apache::lonnet::perlvar{'lonDefDomain'},
                   14612: 	     "request.course.fn"  => '',
                   14613: 	     "request.course.uri" => '',
                   14614: 	     "request.course.sec" => '',
                   14615: 	     "request.role"       => 'cm',
                   14616: 	     "request.role.adv"   => $env{'user.adv'},
                   14617: 	     "request.host"       => $ENV{'REMOTE_ADDR'},);
                   14618: 
                   14619:         if ($form->{'localpath'}) {
                   14620: 	    $initial_env{"browser.localpath"}  = $form->{'localpath'};
                   14621: 	    $initial_env{"browser.localres"}   = $form->{'localres'};
                   14622:         }
                   14623: 	
                   14624: 	if ($form->{'interface'}) {
                   14625: 	    $form->{'interface'}=~s/\W//gs;
                   14626: 	    $initial_env{"browser.interface"} = $form->{'interface'};
                   14627: 	    $env{'browser.interface'}=$form->{'interface'};
                   14628: 	}
                   14629: 
1.1075.2.54  raeburn  14630:         if ($form->{'iptoken'}) {
                   14631:             my $lonhost = $r->dir_config('lonHostID');
                   14632:             $initial_env{"user.noloadbalance"} = $lonhost;
                   14633:             $env{'user.noloadbalance'} = $lonhost;
                   14634:         }
                   14635: 
1.981     raeburn  14636:         my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016    raeburn  14637:         my %domdef;
                   14638:         unless ($domain eq 'public') {
                   14639:             %domdef = &Apache::lonnet::get_domain_defaults($domain);
                   14640:         }
1.980     raeburn  14641: 
1.1075.2.7  raeburn  14642:         foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724     raeburn  14643:             $userenv{'availabletools.'.$tool} = 
1.980     raeburn  14644:                 &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
                   14645:                                                   undef,\%userenv,\%domdef,\%is_adv);
1.724     raeburn  14646:         }
                   14647: 
1.1075.2.59  raeburn  14648:         foreach my $crstype ('official','unofficial','community','textbook') {
1.765     raeburn  14649:             $userenv{'canrequest.'.$crstype} =
                   14650:                 &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980     raeburn  14651:                                                   'reload','requestcourses',
                   14652:                                                   \%userenv,\%domdef,\%is_adv);
1.765     raeburn  14653:         }
                   14654: 
1.1075.2.14  raeburn  14655:         $userenv{'canrequest.author'} =
                   14656:             &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                   14657:                                         'reload','requestauthor',
                   14658:                                         \%userenv,\%domdef,\%is_adv);
                   14659:         my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                   14660:                                              $domain,$username);
                   14661:         my $reqstatus = $reqauthor{'author_status'};
                   14662:         if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
                   14663:             if (ref($reqauthor{'author'}) eq 'HASH') {
                   14664:                 $userenv{'requestauthorqueued'} = $reqstatus.':'.
                   14665:                                                   $reqauthor{'author'}{'timestamp'};
                   14666:             }
                   14667:         }
                   14668: 
1.462     albertel 14669: 	$env{'user.environment'} = "$lonids/$cookie.id";
1.1062    raeburn  14670: 
1.462     albertel 14671: 	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
                   14672: 		 &GDBM_WRCREAT(),0640)) {
                   14673: 	    &_add_to_env(\%disk_env,\%initial_env);
                   14674: 	    &_add_to_env(\%disk_env,\%userenv,'environment.');
                   14675: 	    &_add_to_env(\%disk_env,$userroles);
1.1062    raeburn  14676:             if (ref($firstaccenv) eq 'HASH') {
                   14677:                 &_add_to_env(\%disk_env,$firstaccenv);
                   14678:             }
                   14679:             if (ref($timerintenv) eq 'HASH') {
                   14680:                 &_add_to_env(\%disk_env,$timerintenv);
                   14681:             }
1.463     albertel 14682: 	    if (ref($args->{'extra_env'})) {
                   14683: 		&_add_to_env(\%disk_env,$args->{'extra_env'});
                   14684: 	    }
1.462     albertel 14685: 	    untie(%disk_env);
                   14686: 	} else {
1.705     tempelho 14687: 	    &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
                   14688: 			   'Could not create environment storage in lonauth: '.$!.'</span>');
1.462     albertel 14689: 	    return 'error: '.$!;
                   14690: 	}
                   14691:     }
                   14692:     $env{'request.role'}='cm';
                   14693:     $env{'request.role.adv'}=$env{'user.adv'};
                   14694:     $env{'browser.type'}=$clientbrowser;
                   14695: 
                   14696:     return $cookie;
                   14697: 
                   14698: }
                   14699: 
                   14700: sub _add_to_env {
                   14701:     my ($idf,$env_data,$prefix) = @_;
1.676     raeburn  14702:     if (ref($env_data) eq 'HASH') {
                   14703:         while (my ($key,$value) = each(%$env_data)) {
                   14704: 	    $idf->{$prefix.$key} = $value;
                   14705: 	    $env{$prefix.$key}   = $value;
                   14706:         }
1.462     albertel 14707:     }
                   14708: }
                   14709: 
1.685     tempelho 14710: # --- Get the symbolic name of a problem and the url
                   14711: sub get_symb {
                   14712:     my ($request,$silent) = @_;
1.726     raeburn  14713:     (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685     tempelho 14714:     my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
                   14715:     if ($symb eq '') {
                   14716:         if (!$silent) {
1.1071    raeburn  14717:             if (ref($request)) { 
                   14718:                 $request->print("Unable to handle ambiguous references:$url:.");
                   14719:             }
1.685     tempelho 14720:             return ();
                   14721:         }
                   14722:     }
                   14723:     &Apache::lonenc::check_decrypt(\$symb);
                   14724:     return ($symb);
                   14725: }
                   14726: 
                   14727: # --------------------------------------------------------------Get annotation
                   14728: 
                   14729: sub get_annotation {
                   14730:     my ($symb,$enc) = @_;
                   14731: 
                   14732:     my $key = $symb;
                   14733:     if (!$enc) {
                   14734:         $key =
                   14735:             &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
                   14736:     }
                   14737:     my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
                   14738:     return $annotation{$key};
                   14739: }
                   14740: 
                   14741: sub clean_symb {
1.731     raeburn  14742:     my ($symb,$delete_enc) = @_;
1.685     tempelho 14743: 
                   14744:     &Apache::lonenc::check_decrypt(\$symb);
                   14745:     my $enc = $env{'request.enc'};
1.731     raeburn  14746:     if ($delete_enc) {
1.730     raeburn  14747:         delete($env{'request.enc'});
                   14748:     }
1.685     tempelho 14749: 
                   14750:     return ($symb,$enc);
                   14751: }
1.462     albertel 14752: 
1.1075.2.69  raeburn  14753: ############################################################
                   14754: ############################################################
                   14755: 
                   14756: =pod
                   14757: 
                   14758: =head1 Routines for building display used to search for courses
                   14759: 
                   14760: 
                   14761: =over 4
                   14762: 
                   14763: =item * &build_filters()
                   14764: 
                   14765: Create markup for a table used to set filters to use when selecting
                   14766: courses in a domain.  Used by lonpickcourse.pm, lonmodifycourse.pm
                   14767: and quotacheck.pl
                   14768: 
                   14769: 
                   14770: Inputs:
                   14771: 
                   14772: filterlist - anonymous array of fields to include as potential filters
                   14773: 
                   14774: crstype - course type
                   14775: 
                   14776: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
                   14777:               to pop-open a course selector (will contain "extra element").
                   14778: 
                   14779: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
                   14780: 
                   14781: filter - anonymous hash of criteria and their values
                   14782: 
                   14783: action - form action
                   14784: 
                   14785: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
                   14786: 
                   14787: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
                   14788: 
                   14789: cloneruname - username of owner of new course who wants to clone
                   14790: 
                   14791: clonerudom - domain of owner of new course who wants to clone
                   14792: 
                   14793: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
                   14794: 
                   14795: codetitlesref - reference to array of titles of components in institutional codes (official courses)
                   14796: 
                   14797: codedom - domain
                   14798: 
                   14799: formname - value of form element named "form".
                   14800: 
                   14801: fixeddom - domain, if fixed.
                   14802: 
                   14803: prevphase - value to assign to form element named "phase" when going back to the previous screen
                   14804: 
                   14805: cnameelement - name of form element in form on opener page which will receive title of selected course
                   14806: 
                   14807: cnumelement - name of form element in form on opener page which will receive courseID  of selected course
                   14808: 
                   14809: cdomelement - name of form element in form on opener page which will receive domain of selected course
                   14810: 
                   14811: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
                   14812: 
                   14813: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
                   14814: 
                   14815: clonewarning - warning message about missing information for intended course owner when DC creates a course
                   14816: 
                   14817: 
                   14818: Returns: $output - HTML for display of search criteria, and hidden form elements.
                   14819: 
                   14820: 
                   14821: Side Effects: None
                   14822: 
                   14823: =cut
                   14824: 
                   14825: # ---------------------------------------------- search for courses based on last activity etc.
                   14826: 
                   14827: sub build_filters {
                   14828:     my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
                   14829:         $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
                   14830:         $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
                   14831:         $cnameelement,$cnumelement,$cdomelement,$setroles,
                   14832:         $clonetext,$clonewarning) = @_;
                   14833:     my ($list,$jscript);
                   14834:     my $onchange = 'javascript:updateFilters(this)';
                   14835:     my ($domainselectform,$sincefilterform,$createdfilterform,
                   14836:         $ownerdomselectform,$persondomselectform,$instcodeform,
                   14837:         $typeselectform,$instcodetitle);
                   14838:     if ($formname eq '') {
                   14839:         $formname = $caller;
                   14840:     }
                   14841:     foreach my $item (@{$filterlist}) {
                   14842:         unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
                   14843:                 ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
                   14844:             if ($item eq 'domainfilter') {
                   14845:                 $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
                   14846:             } elsif ($item eq 'coursefilter') {
                   14847:                 $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
                   14848:             } elsif ($item eq 'ownerfilter') {
                   14849:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14850:             } elsif ($item eq 'ownerdomfilter') {
                   14851:                 $filter->{'ownerdomfilter'} =
                   14852:                     &LONCAPA::clean_domain($filter->{$item});
                   14853:                 $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
                   14854:                                                        'ownerdomfilter',1);
                   14855:             } elsif ($item eq 'personfilter') {
                   14856:                 $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
                   14857:             } elsif ($item eq 'persondomfilter') {
                   14858:                 $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
                   14859:                                                         'persondomfilter',1);
                   14860:             } else {
                   14861:                 $filter->{$item} =~ s/\W//g;
                   14862:             }
                   14863:             if (!$filter->{$item}) {
                   14864:                 $filter->{$item} = '';
                   14865:             }
                   14866:         }
                   14867:         if ($item eq 'domainfilter') {
                   14868:             my $allow_blank = 1;
                   14869:             if ($formname eq 'portform') {
                   14870:                 $allow_blank=0;
                   14871:             } elsif ($formname eq 'studentform') {
                   14872:                 $allow_blank=0;
                   14873:             }
                   14874:             if ($fixeddom) {
                   14875:                 $domainselectform = '<input type="hidden" name="domainfilter"'.
                   14876:                                     ' value="'.$codedom.'" />'.
                   14877:                                     &Apache::lonnet::domain($codedom,'description');
                   14878:             } else {
                   14879:                 $domainselectform = &select_dom_form($filter->{$item},
                   14880:                                                      'domainfilter',
                   14881:                                                       $allow_blank,'',$onchange);
                   14882:             }
                   14883:         } else {
                   14884:             $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
                   14885:         }
                   14886:     }
                   14887: 
                   14888:     # last course activity filter and selection
                   14889:     $sincefilterform = &timebased_select_form('sincefilter',$filter);
                   14890: 
                   14891:     # course created filter and selection
                   14892:     if (exists($filter->{'createdfilter'})) {
                   14893:         $createdfilterform = &timebased_select_form('createdfilter',$filter);
                   14894:     }
                   14895: 
                   14896:     my %lt = &Apache::lonlocal::texthash(
                   14897:                 'cac' => "$crstype Activity",
                   14898:                 'ccr' => "$crstype Created",
                   14899:                 'cde' => "$crstype Title",
                   14900:                 'cdo' => "$crstype Domain",
                   14901:                 'ins' => 'Institutional Code',
                   14902:                 'inc' => 'Institutional Categorization',
                   14903:                 'cow' => "$crstype Owner/Co-owner",
                   14904:                 'cop' => "$crstype Personnel Includes",
                   14905:                 'cog' => 'Type',
                   14906:              );
                   14907: 
                   14908:     if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   14909:         my $typeval = 'Course';
                   14910:         if ($crstype eq 'Community') {
                   14911:             $typeval = 'Community';
                   14912:         }
                   14913:         $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
                   14914:     } else {
                   14915:         $typeselectform =  '<select name="type" size="1"';
                   14916:         if ($onchange) {
                   14917:             $typeselectform .= ' onchange="'.$onchange.'"';
                   14918:         }
                   14919:         $typeselectform .= '>'."\n";
                   14920:         foreach my $posstype ('Course','Community') {
                   14921:             $typeselectform.='<option value="'.$posstype.'"'.
                   14922:                 ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
                   14923:         }
                   14924:         $typeselectform.="</select>";
                   14925:     }
                   14926: 
                   14927:     my ($cloneableonlyform,$cloneabletitle);
                   14928:     if (exists($filter->{'cloneableonly'})) {
                   14929:         my $cloneableon = '';
                   14930:         my $cloneableoff = ' checked="checked"';
                   14931:         if ($filter->{'cloneableonly'}) {
                   14932:             $cloneableon = $cloneableoff;
                   14933:             $cloneableoff = '';
                   14934:         }
                   14935:         $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>';
                   14936:         if ($formname eq 'ccrs') {
1.1075.2.71  raeburn  14937:             $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69  raeburn  14938:         } else {
                   14939:             $cloneabletitle = &mt('Cloneable by you');
                   14940:         }
                   14941:     }
                   14942:     my $officialjs;
                   14943:     if ($crstype eq 'Course') {
                   14944:         if (exists($filter->{'instcodefilter'})) {
                   14945: #            if (($fixeddom) || ($formname eq 'requestcrs') ||
                   14946: #                ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
                   14947:             if ($codedom) {
                   14948:                 $officialjs = 1;
                   14949:                 ($instcodeform,$jscript,$$numtitlesref) =
                   14950:                     &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
                   14951:                                                                   $officialjs,$codetitlesref);
                   14952:                 if ($jscript) {
                   14953:                     $jscript = '<script type="text/javascript">'."\n".
                   14954:                                '// <![CDATA['."\n".
                   14955:                                $jscript."\n".
                   14956:                                '// ]]>'."\n".
                   14957:                                '</script>'."\n";
                   14958:                 }
                   14959:             }
                   14960:             if ($instcodeform eq '') {
                   14961:                 $instcodeform =
                   14962:                     '<input type="text" name="instcodefilter" size="10" value="'.
                   14963:                     $list->{'instcodefilter'}.'" />';
                   14964:                 $instcodetitle = $lt{'ins'};
                   14965:             } else {
                   14966:                 $instcodetitle = $lt{'inc'};
                   14967:             }
                   14968:             if ($fixeddom) {
                   14969:                 $instcodetitle .= '<br />('.$codedom.')';
                   14970:             }
                   14971:         }
                   14972:     }
                   14973:     my $output = qq|
                   14974: <form method="post" name="filterpicker" action="$action">
                   14975: <input type="hidden" name="form" value="$formname" />
                   14976: |;
                   14977:     if ($formname eq 'modifycourse') {
                   14978:         $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
                   14979:                    '<input type="hidden" name="prevphase" value="'.
                   14980:                    $prevphase.'" />'."\n";
1.1075.2.82  raeburn  14981:     } elsif ($formname eq 'quotacheck') {
                   14982:         $output .= qq|
                   14983: <input type="hidden" name="sortby" value="" />
                   14984: <input type="hidden" name="sortorder" value="" />
                   14985: |;
                   14986:     } else {
1.1075.2.69  raeburn  14987:         my $name_input;
                   14988:         if ($cnameelement ne '') {
                   14989:             $name_input = '<input type="hidden" name="cnameelement" value="'.
                   14990:                           $cnameelement.'" />';
                   14991:         }
                   14992:         $output .= qq|
                   14993: <input type="hidden" name="cnumelement" value="$cnumelement" />
                   14994: <input type="hidden" name="cdomelement" value="$cdomelement" />
                   14995: $name_input
                   14996: $roleelement
                   14997: $multelement
                   14998: $typeelement
                   14999: |;
                   15000:         if ($formname eq 'portform') {
                   15001:             $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
                   15002:         }
                   15003:     }
                   15004:     if ($fixeddom) {
                   15005:         $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
                   15006:     }
                   15007:     $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
                   15008:     if ($sincefilterform) {
                   15009:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
                   15010:                   .$sincefilterform
                   15011:                   .&Apache::lonhtmlcommon::row_closure();
                   15012:     }
                   15013:     if ($createdfilterform) {
                   15014:         $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
                   15015:                   .$createdfilterform
                   15016:                   .&Apache::lonhtmlcommon::row_closure();
                   15017:     }
                   15018:     if ($domainselectform) {
                   15019:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
                   15020:                   .$domainselectform
                   15021:                   .&Apache::lonhtmlcommon::row_closure();
                   15022:     }
                   15023:     if ($typeselectform) {
                   15024:         if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
                   15025:             $output .= $typeselectform;
                   15026:         } else {
                   15027:             $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
                   15028:                       .$typeselectform
                   15029:                       .&Apache::lonhtmlcommon::row_closure();
                   15030:         }
                   15031:     }
                   15032:     if ($instcodeform) {
                   15033:         $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
                   15034:                   .$instcodeform
                   15035:                   .&Apache::lonhtmlcommon::row_closure();
                   15036:     }
                   15037:     if (exists($filter->{'ownerfilter'})) {
                   15038:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
                   15039:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15040:                    '<input type="text" name="ownerfilter" size="20" value="'.
                   15041:                    $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15042:                    $ownerdomselectform.'</td></tr></table>'.
                   15043:                    &Apache::lonhtmlcommon::row_closure();
                   15044:     }
                   15045:     if (exists($filter->{'personfilter'})) {
                   15046:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
                   15047:                    '<table><tr><td>'.&mt('Username').'<br />'.
                   15048:                    '<input type="text" name="personfilter" size="20" value="'.
                   15049:                    $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
                   15050:                    $persondomselectform.'</td></tr></table>'.
                   15051:                    &Apache::lonhtmlcommon::row_closure();
                   15052:     }
                   15053:     if (exists($filter->{'coursefilter'})) {
                   15054:         $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
                   15055:                   .'<input type="text" name="coursefilter" size="25" value="'
                   15056:                   .$list->{'coursefilter'}.'" />'
                   15057:                   .&Apache::lonhtmlcommon::row_closure();
                   15058:     }
                   15059:     if ($cloneableonlyform) {
                   15060:         $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
                   15061:                    $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
                   15062:     }
                   15063:     if (exists($filter->{'descriptfilter'})) {
                   15064:         $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
                   15065:                   .'<input type="text" name="descriptfilter" size="40" value="'
                   15066:                   .$list->{'descriptfilter'}.'" />'
                   15067:                   .&Apache::lonhtmlcommon::row_closure(1);
                   15068:     }
                   15069:     $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
                   15070:                '<input type="hidden" name="updater" value="" />'."\n".
                   15071:                '<input type="submit" name="gosearch" value="'.
                   15072:                &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
                   15073:     return $jscript.$clonewarning.$output;
                   15074: }
                   15075: 
                   15076: =pod
                   15077: 
                   15078: =item * &timebased_select_form()
                   15079: 
                   15080: Create markup for a dropdown list used to select a time-based
                   15081: filter e.g., Course Activity, Course Created, when searching for courses
                   15082: or communities
                   15083: 
                   15084: Inputs:
                   15085: 
                   15086: item - name of form element (sincefilter or createdfilter)
                   15087: 
                   15088: filter - anonymous hash of criteria and their values
                   15089: 
                   15090: Returns: HTML for a select box contained a blank, then six time selections,
                   15091:          with value set in incoming form variables currently selected.
                   15092: 
                   15093: Side Effects: None
                   15094: 
                   15095: =cut
                   15096: 
                   15097: sub timebased_select_form {
                   15098:     my ($item,$filter) = @_;
                   15099:     if (ref($filter) eq 'HASH') {
                   15100:         $filter->{$item} =~ s/[^\d-]//g;
                   15101:         if (!$filter->{$item}) { $filter->{$item}=-1; }
                   15102:         return &select_form(
                   15103:                             $filter->{$item},
                   15104:                             $item,
                   15105:                             {      '-1' => '',
                   15106:                                 '86400' => &mt('today'),
                   15107:                                '604800' => &mt('last week'),
                   15108:                               '2592000' => &mt('last month'),
                   15109:                               '7776000' => &mt('last three months'),
                   15110:                              '15552000' => &mt('last six months'),
                   15111:                              '31104000' => &mt('last year'),
                   15112:                     'select_form_order' =>
                   15113:                            ['-1','86400','604800','2592000','7776000',
                   15114:                             '15552000','31104000']});
                   15115:     }
                   15116: }
                   15117: 
                   15118: =pod
                   15119: 
                   15120: =item * &js_changer()
                   15121: 
                   15122: Create script tag containing Javascript used to submit course search form
                   15123: when course type or domain is changed, and also to hide 'Searching ...' on
                   15124: page load completion for page showing search result.
                   15125: 
                   15126: Inputs: None
                   15127: 
                   15128: Returns: markup containing updateFilters() and hideSearching() javascript functions.
                   15129: 
                   15130: Side Effects: None
                   15131: 
                   15132: =cut
                   15133: 
                   15134: sub js_changer {
                   15135:     return <<ENDJS;
                   15136: <script type="text/javascript">
                   15137: // <![CDATA[
                   15138: function updateFilters(caller) {
                   15139:     if (typeof(caller) != "undefined") {
                   15140:         document.filterpicker.updater.value = caller.name;
                   15141:     }
                   15142:     document.filterpicker.submit();
                   15143: }
                   15144: 
                   15145: function hideSearching() {
                   15146:     if (document.getElementById('searching')) {
                   15147:         document.getElementById('searching').style.display = 'none';
                   15148:     }
                   15149:     return;
                   15150: }
                   15151: 
                   15152: // ]]>
                   15153: </script>
                   15154: 
                   15155: ENDJS
                   15156: }
                   15157: 
                   15158: =pod
                   15159: 
                   15160: =item * &search_courses()
                   15161: 
                   15162: Process selected filters form course search form and pass to lonnet::courseiddump
                   15163: to retrieve a hash for which keys are courseIDs which match the selected filters.
                   15164: 
                   15165: Inputs:
                   15166: 
                   15167: dom - domain being searched
                   15168: 
                   15169: type - course type ('Course' or 'Community' or '.' if any).
                   15170: 
                   15171: filter - anonymous hash of criteria and their values
                   15172: 
                   15173: numtitles - for institutional codes - number of categories
                   15174: 
                   15175: cloneruname - optional username of new course owner
                   15176: 
                   15177: clonerudom - optional domain of new course owner
                   15178: 
                   15179: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
                   15180:             (used when DC is using course creation form)
                   15181: 
                   15182: codetitles - reference to array of titles of components in institutional codes (official courses).
                   15183: 
                   15184: 
                   15185: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
                   15186: 
                   15187: 
                   15188: Side Effects: None
                   15189: 
                   15190: =cut
                   15191: 
                   15192: 
                   15193: sub search_courses {
                   15194:     my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
                   15195:     my (%courses,%showcourses,$cloner);
                   15196:     if (($filter->{'ownerfilter'} ne '') ||
                   15197:         ($filter->{'ownerdomfilter'} ne '')) {
                   15198:         $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
                   15199:                                        $filter->{'ownerdomfilter'};
                   15200:     }
                   15201:     foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
                   15202:         if (!$filter->{$item}) {
                   15203:             $filter->{$item}='.';
                   15204:         }
                   15205:     }
                   15206:     my $now = time;
                   15207:     my $timefilter =
                   15208:        ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
                   15209:     my ($createdbefore,$createdafter);
                   15210:     if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
                   15211:         $createdbefore = $now;
                   15212:         $createdafter = $now-$filter->{'createdfilter'};
                   15213:     }
                   15214:     my ($instcodefilter,$regexpok);
                   15215:     if ($numtitles) {
                   15216:         if ($env{'form.official'} eq 'on') {
                   15217:             $instcodefilter =
                   15218:                 &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15219:             $regexpok = 1;
                   15220:         } elsif ($env{'form.official'} eq 'off') {
                   15221:             $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
                   15222:             unless ($instcodefilter eq '') {
                   15223:                 $regexpok = -1;
                   15224:             }
                   15225:         }
                   15226:     } else {
                   15227:         $instcodefilter = $filter->{'instcodefilter'};
                   15228:     }
                   15229:     if ($instcodefilter eq '') { $instcodefilter = '.'; }
                   15230:     if ($type eq '') { $type = '.'; }
                   15231: 
                   15232:     if (($clonerudom ne '') && ($cloneruname ne '')) {
                   15233:         $cloner = $cloneruname.':'.$clonerudom;
                   15234:     }
                   15235:     %courses = &Apache::lonnet::courseiddump($dom,
                   15236:                                              $filter->{'descriptfilter'},
                   15237:                                              $timefilter,
                   15238:                                              $instcodefilter,
                   15239:                                              $filter->{'combownerfilter'},
                   15240:                                              $filter->{'coursefilter'},
                   15241:                                              undef,undef,$type,$regexpok,undef,undef,
                   15242:                                              undef,undef,$cloner,$env{'form.cc_clone'},
                   15243:                                              $filter->{'cloneableonly'},
                   15244:                                              $createdbefore,$createdafter,undef,
                   15245:                                              $domcloner);
                   15246:     if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
                   15247:         my $ccrole;
                   15248:         if ($type eq 'Community') {
                   15249:             $ccrole = 'co';
                   15250:         } else {
                   15251:             $ccrole = 'cc';
                   15252:         }
                   15253:         my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
                   15254:                                                      $filter->{'persondomfilter'},
                   15255:                                                      'userroles',undef,
                   15256:                                                      [$ccrole,'in','ad','ep','ta','cr'],
                   15257:                                                      $dom);
                   15258:         foreach my $role (keys(%rolehash)) {
                   15259:             my ($cnum,$cdom,$courserole) = split(':',$role);
                   15260:             my $cid = $cdom.'_'.$cnum;
                   15261:             if (exists($courses{$cid})) {
                   15262:                 if (ref($courses{$cid}) eq 'HASH') {
                   15263:                     if (ref($courses{$cid}{roles}) eq 'ARRAY') {
                   15264:                         if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
                   15265:                             push (@{$courses{$cid}{roles}},$courserole);
                   15266:                         }
                   15267:                     } else {
                   15268:                         $courses{$cid}{roles} = [$courserole];
                   15269:                     }
                   15270:                     $showcourses{$cid} = $courses{$cid};
                   15271:                 }
                   15272:             }
                   15273:         }
                   15274:         %courses = %showcourses;
                   15275:     }
                   15276:     return %courses;
                   15277: }
                   15278: 
                   15279: =pod
                   15280: 
                   15281: =back
                   15282: 
                   15283: =cut
                   15284: 
                   15285: 
1.1075.2.11  raeburn  15286: sub update_content_constraints {
                   15287:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15288:     my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
                   15289:     my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
                   15290:     my %checkresponsetypes;
                   15291:     foreach my $key (keys(%Apache::lonnet::needsrelease)) {
                   15292:         my ($item,$name,$value) = split(/:/,$key);
                   15293:         if ($item eq 'resourcetag') {
                   15294:             if ($name eq 'responsetype') {
                   15295:                 $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
                   15296:             }
                   15297:         }
                   15298:     }
                   15299:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15300:     if (defined($navmap)) {
                   15301:         my %allresponses;
                   15302:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
                   15303:             my %responses = $res->responseTypes();
                   15304:             foreach my $key (keys(%responses)) {
                   15305:                 next unless(exists($checkresponsetypes{$key}));
                   15306:                 $allresponses{$key} += $responses{$key};
                   15307:             }
                   15308:         }
                   15309:         foreach my $key (keys(%allresponses)) {
                   15310:             my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
                   15311:             if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
                   15312:                 ($reqdmajor,$reqdminor) = ($major,$minor);
                   15313:             }
                   15314:         }
                   15315:         undef($navmap);
                   15316:     }
                   15317:     unless (($reqdmajor eq '') && ($reqdminor eq '')) {
                   15318:         &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
                   15319:     }
                   15320:     return;
                   15321: }
                   15322: 
1.1075.2.27  raeburn  15323: sub allmaps_incourse {
                   15324:     my ($cdom,$cnum,$chome,$cid) = @_;
                   15325:     if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
                   15326:         $cid = $env{'request.course.id'};
                   15327:         $cdom = $env{'course.'.$cid.'.domain'};
                   15328:         $cnum = $env{'course.'.$cid.'.num'};
                   15329:         $chome = $env{'course.'.$cid.'.home'};
                   15330:     }
                   15331:     my %allmaps = ();
                   15332:     my $lastchange =
                   15333:         &Apache::lonnet::get_coursechange($cdom,$cnum);
                   15334:     if ($lastchange > $env{'request.course.tied'}) {
                   15335:         my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
                   15336:         unless ($ferr) {
                   15337:             &update_content_constraints($cdom,$cnum,$chome,$cid);
                   15338:         }
                   15339:     }
                   15340:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15341:     if (defined($navmap)) {
                   15342:         foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
                   15343:             $allmaps{$res->src()} = 1;
                   15344:         }
                   15345:     }
                   15346:     return \%allmaps;
                   15347: }
                   15348: 
1.1075.2.11  raeburn  15349: sub parse_supplemental_title {
                   15350:     my ($title) = @_;
                   15351: 
                   15352:     my ($foldertitle,$renametitle);
                   15353:     if ($title =~ /&amp;&amp;&amp;/) {
                   15354:         $title = &HTML::Entites::decode($title);
                   15355:     }
                   15356:     if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
                   15357:         $renametitle=$4;
                   15358:         my ($time,$uname,$udom) = ($1,$2,$3);
                   15359:         $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
                   15360:         my $name =  &plainname($uname,$udom);
                   15361:         $name = &HTML::Entities::encode($name,'"<>&\'');
                   15362:         $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
                   15363:         $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
                   15364:             $name.': <br />'.$foldertitle;
                   15365:     }
                   15366:     if (wantarray) {
                   15367:         return ($title,$foldertitle,$renametitle);
                   15368:     }
                   15369:     return $title;
                   15370: }
                   15371: 
1.1075.2.43  raeburn  15372: sub recurse_supplemental {
                   15373:     my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
                   15374:     if ($suppmap) {
                   15375:         my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
                   15376:         if ($fatal) {
                   15377:             $errors ++;
                   15378:         } else {
                   15379:             if ($#LONCAPA::map::resources > 0) {
                   15380:                 foreach my $res (@LONCAPA::map::resources) {
                   15381:                     my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
                   15382:                     if (($src ne '') && ($status eq 'res')) {
1.1075.2.46  raeburn  15383:                         if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
                   15384:                             ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43  raeburn  15385:                         } else {
                   15386:                             $numfiles ++;
                   15387:                         }
                   15388:                     }
                   15389:                 }
                   15390:             }
                   15391:         }
                   15392:     }
                   15393:     return ($numfiles,$errors);
                   15394: }
                   15395: 
1.1075.2.18  raeburn  15396: sub symb_to_docspath {
                   15397:     my ($symb) = @_;
                   15398:     return unless ($symb);
                   15399:     my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
                   15400:     if ($resurl=~/\.(sequence|page)$/) {
                   15401:         $mapurl=$resurl;
                   15402:     } elsif ($resurl eq 'adm/navmaps') {
                   15403:         $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
                   15404:     }
                   15405:     my $mapresobj;
                   15406:     my $navmap = Apache::lonnavmaps::navmap->new();
                   15407:     if (ref($navmap)) {
                   15408:         $mapresobj = $navmap->getResourceByUrl($mapurl);
                   15409:     }
                   15410:     $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
                   15411:     my $type=$2;
                   15412:     my $path;
                   15413:     if (ref($mapresobj)) {
                   15414:         my $pcslist = $mapresobj->map_hierarchy();
                   15415:         if ($pcslist ne '') {
                   15416:             foreach my $pc (split(/,/,$pcslist)) {
                   15417:                 next if ($pc <= 1);
                   15418:                 my $res = $navmap->getByMapPc($pc);
                   15419:                 if (ref($res)) {
                   15420:                     my $thisurl = $res->src();
                   15421:                     $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
                   15422:                     my $thistitle = $res->title();
                   15423:                     $path .= '&'.
                   15424:                              &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46  raeburn  15425:                              &escape($thistitle).
1.1075.2.18  raeburn  15426:                              ':'.$res->randompick().
                   15427:                              ':'.$res->randomout().
                   15428:                              ':'.$res->encrypted().
                   15429:                              ':'.$res->randomorder().
                   15430:                              ':'.$res->is_page();
                   15431:                 }
                   15432:             }
                   15433:         }
                   15434:         $path =~ s/^\&//;
                   15435:         my $maptitle = $mapresobj->title();
                   15436:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15437:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15438:         }
                   15439:         $path .= (($path ne '')? '&' : '').
                   15440:                  &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15441:                  &escape($maptitle).
1.1075.2.18  raeburn  15442:                  ':'.$mapresobj->randompick().
                   15443:                  ':'.$mapresobj->randomout().
                   15444:                  ':'.$mapresobj->encrypted().
                   15445:                  ':'.$mapresobj->randomorder().
                   15446:                  ':'.$mapresobj->is_page();
                   15447:     } else {
                   15448:         my $maptitle = &Apache::lonnet::gettitle($mapurl);
                   15449:         my $ispage = (($type eq 'page')? 1 : '');
                   15450:         if ($mapurl eq 'default') {
1.1075.2.38  raeburn  15451:             $maptitle = 'Main Content';
1.1075.2.18  raeburn  15452:         }
                   15453:         $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46  raeburn  15454:                 &escape($maptitle).':::::'.$ispage;
1.1075.2.18  raeburn  15455:     }
                   15456:     unless ($mapurl eq 'default') {
                   15457:         $path = 'default&'.
1.1075.2.46  raeburn  15458:                 &escape('Main Content').
1.1075.2.18  raeburn  15459:                 ':::::&'.$path;
                   15460:     }
                   15461:     return $path;
                   15462: }
                   15463: 
1.1075.2.14  raeburn  15464: sub captcha_display {
                   15465:     my ($context,$lonhost) = @_;
                   15466:     my ($output,$error);
                   15467:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   15468:     if ($captcha eq 'original') {
                   15469:         $output = &create_captcha();
                   15470:         unless ($output) {
                   15471:             $error = 'captcha';
                   15472:         }
                   15473:     } elsif ($captcha eq 'recaptcha') {
                   15474:         $output = &create_recaptcha($pubkey);
                   15475:         unless ($output) {
                   15476:             $error = 'recaptcha';
                   15477:         }
                   15478:     }
1.1075.2.66  raeburn  15479:     return ($output,$error,$captcha);
1.1075.2.14  raeburn  15480: }
                   15481: 
                   15482: sub captcha_response {
                   15483:     my ($context,$lonhost) = @_;
                   15484:     my ($captcha_chk,$captcha_error);
                   15485:     my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
                   15486:     if ($captcha eq 'original') {
                   15487:         ($captcha_chk,$captcha_error) = &check_captcha();
                   15488:     } elsif ($captcha eq 'recaptcha') {
                   15489:         $captcha_chk = &check_recaptcha($privkey);
                   15490:     } else {
                   15491:         $captcha_chk = 1;
                   15492:     }
                   15493:     return ($captcha_chk,$captcha_error);
                   15494: }
                   15495: 
                   15496: sub get_captcha_config {
                   15497:     my ($context,$lonhost) = @_;
                   15498:     my ($captcha,$pubkey,$privkey,$hashtocheck);
                   15499:     my $hostname = &Apache::lonnet::hostname($lonhost);
                   15500:     my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
                   15501:     my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
                   15502:     if ($context eq 'usercreation') {
                   15503:         my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
                   15504:         if (ref($domconfig{$context}) eq 'HASH') {
                   15505:             $hashtocheck = $domconfig{$context}{'cancreate'};
                   15506:             if (ref($hashtocheck) eq 'HASH') {
                   15507:                 if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                   15508:                     if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                   15509:                         $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                   15510:                         $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                   15511:                     }
                   15512:                     if ($privkey && $pubkey) {
                   15513:                         $captcha = 'recaptcha';
                   15514:                     } else {
                   15515:                         $captcha = 'original';
                   15516:                     }
                   15517:                 } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                   15518:                     $captcha = 'original';
                   15519:                 }
                   15520:             }
                   15521:         } else {
                   15522:             $captcha = 'captcha';
                   15523:         }
                   15524:     } elsif ($context eq 'login') {
                   15525:         my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
                   15526:         if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
                   15527:             $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
                   15528:             $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
                   15529:             if ($privkey && $pubkey) {
                   15530:                 $captcha = 'recaptcha';
                   15531:             } else {
                   15532:                 $captcha = 'original';
                   15533:             }
                   15534:         } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
                   15535:             $captcha = 'original';
                   15536:         }
                   15537:     }
                   15538:     return ($captcha,$pubkey,$privkey);
                   15539: }
                   15540: 
                   15541: sub create_captcha {
                   15542:     my %captcha_params = &captcha_settings();
                   15543:     my ($output,$maxtries,$tries) = ('',10,0);
                   15544:     while ($tries < $maxtries) {
                   15545:         $tries ++;
                   15546:         my $captcha = Authen::Captcha->new (
                   15547:                                            output_folder => $captcha_params{'output_dir'},
                   15548:                                            data_folder   => $captcha_params{'db_dir'},
                   15549:                                           );
                   15550:         my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
                   15551: 
                   15552:         if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
                   15553:             $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
                   15554:                       &mt('Type in the letters/numbers shown below').'&nbsp;'.
1.1075.2.66  raeburn  15555:                       '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
                   15556:                       '<br />'.
                   15557:                       '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14  raeburn  15558:             last;
                   15559:         }
                   15560:     }
                   15561:     return $output;
                   15562: }
                   15563: 
                   15564: sub captcha_settings {
                   15565:     my %captcha_params = (
                   15566:                            output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
                   15567:                            www_output_dir => "/captchaspool",
                   15568:                            db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
                   15569:                            numchars       => '5',
                   15570:                          );
                   15571:     return %captcha_params;
                   15572: }
                   15573: 
                   15574: sub check_captcha {
                   15575:     my ($captcha_chk,$captcha_error);
                   15576:     my $code = $env{'form.code'};
                   15577:     my $md5sum = $env{'form.crypt'};
                   15578:     my %captcha_params = &captcha_settings();
                   15579:     my $captcha = Authen::Captcha->new(
                   15580:                       output_folder => $captcha_params{'output_dir'},
                   15581:                       data_folder   => $captcha_params{'db_dir'},
                   15582:                   );
1.1075.2.26  raeburn  15583:     $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14  raeburn  15584:     my %captcha_hash = (
                   15585:                         0       => 'Code not checked (file error)',
                   15586:                        -1      => 'Failed: code expired',
                   15587:                        -2      => 'Failed: invalid code (not in database)',
                   15588:                        -3      => 'Failed: invalid code (code does not match crypt)',
                   15589:     );
                   15590:     if ($captcha_chk != 1) {
                   15591:         $captcha_error = $captcha_hash{$captcha_chk}
                   15592:     }
                   15593:     return ($captcha_chk,$captcha_error);
                   15594: }
                   15595: 
                   15596: sub create_recaptcha {
                   15597:     my ($pubkey) = @_;
1.1075.2.51  raeburn  15598:     my $use_ssl;
                   15599:     if ($ENV{'SERVER_PORT'} == 443) {
                   15600:         $use_ssl = 1;
                   15601:     }
1.1075.2.14  raeburn  15602:     my $captcha = Captcha::reCAPTCHA->new;
                   15603:     return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51  raeburn  15604:            $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.14  raeburn  15605:            &mt('If either word is hard to read, [_1] will replace them.',
1.1075.2.39  raeburn  15606:                '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14  raeburn  15607:            '<br /><br />';
                   15608: }
                   15609: 
                   15610: sub check_recaptcha {
                   15611:     my ($privkey) = @_;
                   15612:     my $captcha_chk;
                   15613:     my $captcha = Captcha::reCAPTCHA->new;
                   15614:     my $captcha_result =
                   15615:         $captcha->check_answer(
                   15616:                                 $privkey,
                   15617:                                 $ENV{'REMOTE_ADDR'},
                   15618:                                 $env{'form.recaptcha_challenge_field'},
                   15619:                                 $env{'form.recaptcha_response_field'},
                   15620:                               );
                   15621:     if ($captcha_result->{is_valid}) {
                   15622:         $captcha_chk = 1;
                   15623:     }
                   15624:     return $captcha_chk;
                   15625: }
                   15626: 
1.1075.2.64  raeburn  15627: sub emailusername_info {
1.1075.2.67  raeburn  15628:     my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1075.2.64  raeburn  15629:     my %titles = &Apache::lonlocal::texthash (
                   15630:                      lastname      => 'Last Name',
                   15631:                      firstname     => 'First Name',
                   15632:                      institution   => 'School/college/university',
                   15633:                      location      => "School's city, state/province, country",
                   15634:                      web           => "School's web address",
                   15635:                      officialemail => 'E-mail address at institution (if different)',
                   15636:                  );
                   15637:     return (\@fields,\%titles);
                   15638: }
                   15639: 
1.1075.2.56  raeburn  15640: sub cleanup_html {
                   15641:     my ($incoming) = @_;
                   15642:     my $outgoing;
                   15643:     if ($incoming ne '') {
                   15644:         $outgoing = $incoming;
                   15645:         $outgoing =~ s/;/&#059;/g;
                   15646:         $outgoing =~ s/\#/&#035;/g;
                   15647:         $outgoing =~ s/\&/&#038;/g;
                   15648:         $outgoing =~ s/</&#060;/g;
                   15649:         $outgoing =~ s/>/&#062;/g;
                   15650:         $outgoing =~ s/\(/&#040/g;
                   15651:         $outgoing =~ s/\)/&#041;/g;
                   15652:         $outgoing =~ s/"/&#034;/g;
                   15653:         $outgoing =~ s/'/&#039;/g;
                   15654:         $outgoing =~ s/\$/&#036;/g;
                   15655:         $outgoing =~ s{/}{&#047;}g;
                   15656:         $outgoing =~ s/=/&#061;/g;
                   15657:         $outgoing =~ s/\\/&#092;/g
                   15658:     }
                   15659:     return $outgoing;
                   15660: }
                   15661: 
1.1075.2.74  raeburn  15662: # Checks for critical messages and returns a redirect url if one exists.
                   15663: # $interval indicates how often to check for messages.
                   15664: sub critical_redirect {
                   15665:     my ($interval) = @_;
                   15666:     if ((time-$env{'user.criticalcheck.time'})>$interval) {
                   15667:         my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
                   15668:                                         $env{'user.name'});
                   15669:         &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
                   15670:         my $redirecturl;
                   15671:         if ($what[0]) {
                   15672:             if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
                   15673:                 $redirecturl='/adm/email?critical=display';
                   15674:                 my $url=&Apache::lonnet::absolute_url().$redirecturl;
                   15675:                 return (1, $url);
                   15676:             }
                   15677:         }
                   15678:     }
                   15679:     return ();
                   15680: }
                   15681: 
1.1075.2.64  raeburn  15682: # Use:
                   15683: #   my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
                   15684: #
                   15685: ##################################################
                   15686: #          password associated functions         #
                   15687: ##################################################
                   15688: sub des_keys {
                   15689:     # Make a new key for DES encryption.
                   15690:     # Each key has two parts which are returned separately.
                   15691:     # Please note:  Each key must be passed through the &hex function
                   15692:     # before it is output to the web browser.  The hex versions cannot
                   15693:     # be used to decrypt.
                   15694:     my @hexstr=('0','1','2','3','4','5','6','7',
                   15695:                 '8','9','a','b','c','d','e','f');
                   15696:     my $lkey='';
                   15697:     for (0..7) {
                   15698:         $lkey.=$hexstr[rand(15)];
                   15699:     }
                   15700:     my $ukey='';
                   15701:     for (0..7) {
                   15702:         $ukey.=$hexstr[rand(15)];
                   15703:     }
                   15704:     return ($lkey,$ukey);
                   15705: }
                   15706: 
                   15707: sub des_decrypt {
                   15708:     my ($key,$cyphertext) = @_;
                   15709:     my $keybin=pack("H16",$key);
                   15710:     my $cypher;
                   15711:     if ($Crypt::DES::VERSION>=2.03) {
                   15712:         $cypher=new Crypt::DES $keybin;
                   15713:     } else {
                   15714:         $cypher=new DES $keybin;
                   15715:     }
                   15716:     my $plaintext=
                   15717:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
                   15718:     $plaintext.=
                   15719:         $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
                   15720:     $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
                   15721:     return $plaintext;
                   15722: }
                   15723: 
1.112     bowersj2 15724: 1;
                   15725: __END__;
1.41      ng       15726: 

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